Macrouv1

Sub Macrou()


    Dim ReadData As String
    Dim line As String
    Dim aString As String
    Dim bString As String
    Dim sizeString As String
    Dim hyperString As String
    Dim linkString As String
    Dim faceString As String
    Dim faceTypeString As String
    Dim pos1 As Integer
    Dim pos2 As Integer
    Dim pos3 As Integer
    Dim pos4 As Integer
    Dim i As Integer
    Dim j As Integer
    Dim tablesAdded As Boolean
    Dim colorString As String
    Open "E:\office.html" For Input As #1
    Do Until EOF(1)
       Line Input #1, ReadData
       pos1 = InStr(ReadData, "<")
       pos2 = InStr(ReadData, ">")
       pos3 = InStr(ReadData, "</")

       aString = Mid(ReadData, (pos1 + 1), (pos2 - pos1 - 1))
       pos4 = Len(aString)
       'Selection.TypeText (ReadData)
       Selection.Font.Size = 12
       Selection.Font.Name = "Times New Roman"
       Selection.Font.Bold = False
       Selection.Font.Italic = False
       Selection.Font.ColorIndex = wdBlack
        If StrComp(aString, "b") = 0 Then
            Selection.Font.Bold = True
            Selection.Font.ColorIndex = wdBlack
            bString = Mid(ReadData, (pos1 + 3), (pos3 - pos1 - 3))
            Selection.TypeText (bString)
            Selection.TypeParagraph
        End If

        If StrComp(aString, "i") = 0 Then
            Selection.Font.Bold = False
            Selection.Font.Italic = True
            Selection.Font.ColorIndex = wdBlack
            bString = Mid(ReadData, (pos1 + 3), (pos3 - pos1 - 3))
            Selection.TypeText (bString)
            Selection.TypeParagraph
        End If

        If StrComp(Left(aString, 4), "font") = 0 Then
                  colorString = Mid(aString, (pos1 + 13), (pos4 - pos1 - 13))
                  sizeString = Mid(aString, (pos1 + 12), (pos4 - pos1 - 12))
                  faceString = Mid(aString, (pos1 + 5), (pos1 + 3))
                  faceTypeString = Mid(aString, (pos1 + 11), (pos4 - pos1 - 11))


                    If StrComp(colorString, "red") = 0 Then
                        Selection.Font.ColorIndex = wdRed
                        Selection.TypeText (Mid(ReadData, (pos4 + 3), (pos3 - pos4 - 3)))
                        Selection.TypeParagraph
                    End If
                    If StrComp(colorString, "yellow") = 0 Then
                        Selection.Font.ColorIndex = wdYellow
                        Selection.TypeText (Mid(ReadData, (pos4 + 3), (pos3 - pos4 - 3)))
                        Selection.TypeParagraph
                    End If
                    If StrComp(colorString, "blue") = 0 Then
                        Selection.Font.ColorIndex = wdBlue
                        Selection.TypeText (Mid(ReadData, (pos4 + 3), (pos3 - pos4 - 3)))
                        Selection.TypeParagraph
                    End If

                    If IsNumeric(sizeString) Then

                        Selection.Font.Size = sizeString
                        Selection.TypeText (Mid(ReadData, (pos4 + 3), (pos3 - pos4 - 3)))
                        Selection.TypeParagraph

                    End If

                     If StrComp(faceString, "face") = 0 Then

                        Selection.Font.Name = faceTypeString
                        Selection.TypeText (Mid(ReadData, (pos4 + 3), (pos3 - pos4 - 3)))
                        Selection.TypeParagraph

                    End If





        Selection.ClearFormatting
        End If

         If StrComp(aString, "ul") = 0 Then
            Selection.Font.Bold = False
            Selection.Font.Italic = False

            Dim listItem As String
            Selection.Range.ListFormat.ApplyBulletDefault

            Do Until InStr(line, "</ul>") > 0
                Line Input #1, line
                If StrComp(line, "</ul>") <> 0 Then
                    pos1 = InStr(line, "<")
                    pos2 = InStr(line, "</")

                    listItem = Mid(line, (pos1 + 4), (pos2 - pos1 - 4))
                    'MsgBox listItem
                    Selection.TypeText (listItem)
                    Selection.TypeParagraph

                End If
            Loop
            'Selection.Range.ParagraphFormat.Reset
            Selection.ClearFormatting
            'MsgBox aString
            'Selection.TypeText (bString)
            Selection.TypeParagraph
        End If

        If StrComp(aString, "ol") = 0 Then
            Selection.Font.Bold = False
            Selection.Font.Italic = False

            Selection.Range.ListFormat.ApplyNumberDefault

            Do Until InStr(line, "</ol>") > 0
                Line Input #1, line
                If StrComp(line, "</ol>") <> 0 Then
                    pos1 = InStr(line, "<")
                    pos2 = InStr(line, "</")

                    listItem = Mid(line, (pos1 + 4), (pos2 - pos1 - 4))
                    'MsgBox listItem
                    Selection.TypeText (listItem)
                    Selection.TypeParagraph

                End If
            Loop
            Selection.ClearFormatting
            'MsgBox aString
            'Selection.TypeText (bString)
            Selection.TypeParagraph
        End If

         If StrComp(aString, "table") = 0 Then
            Selection.Font.Bold = False
            Selection.Font.Italic = False
            Dim trString As String
            Dim tdItem As String
            Dim line2 As String
            Dim pos5 As Integer
            Dim pos6 As Integer
            Dim nrRows As Integer
            Dim nrCols As Integer
            nrRows = 0
            nrCols = 0


            line = "<table>"
            Do Until InStr(line, "</table>") > 0
                Line Input #1, line
                If StrComp(line, "</table>") <> 0 Then
                    pos5 = InStr(line, "<")
                    pos6 = InStr(line, ">")

                    trString = Mid(line, (pos5 + 1), (pos6 - pos5 - 1))
                    'MsgBox trString
                   If StrComp(trString, "tr") = 0 Then
                        nrRows = nrRows + 1
                        nrCols = 0
                        line2 = ""
                        Do Until (InStr(line2, "</tr>") > 0)
                            Line Input #1, line2
                            If ((StrComp(line2, "</tr>") <> 0) And (InStr(line2, "</tr>") <= 0)) Then
                                pos1 = InStr(line2, "<")
                                pos2 = InStr(line2, "</")
                                nrCols = nrCols + 1
                                 tdItem = Mid(line2, (pos1 + 4), (pos2 - pos1 - 4))



                            End If
                        Loop
                    End If
                End If
            Loop


        End If



         If StrComp(Left(aString, 6), "a href") = 0 Then

            hyperString = Mid(aString, (pos1 + 8), (pos4 - pos1 - 8))
            linkString = Mid(ReadData, (pos4 + 3), (pos3 - pos4 - 3))
            Selection.Hyperlinks.Add Anchor:=Selection.Range, _
            Address:=hyperString, TextToDisplay:=linkString


        End If



    Loop

    Close #1

    Open "E:\office.html" For Input As #2
    If StrComp(aString, "table") = 0 Then
            Selection.Font.Bold = False
            Selection.Font.Italic = False




           Dim tblNew As Table
           Set tblNew = Selection.Tables.Add(Selection.Range, nrRows, nrCols)
           nrRows = 0
           nrCols = 0
            line = "<table>"
            Do Until InStr(line, "</table>") > 0
                Line Input #2, line
                If StrComp(line, "</table>") <> 0 Then
                    pos5 = InStr(line, "<")
                    pos6 = InStr(line, ">")

                    trString = Mid(line, (pos5 + 1), (pos6 - pos5 - 1))
                    'MsgBox trString
                   If StrComp(trString, "tr") = 0 Then
                        nrRows = nrRows + 1
                        nrCols = 0
                        line2 = ""
                        Do Until (InStr(line2, "</tr>") > 0)
                            Line Input #2, line2
                            If ((StrComp(line2, "</tr>") <> 0) And (InStr(line2, "</tr>") <= 0)) Then
                                pos1 = InStr(line2, "<")
                                pos2 = InStr(line2, "</")
                                nrCols = nrCols + 1
                                 tdItem = Mid(line2, (pos1 + 4), (pos2 - pos1 - 4))

                                Selection.Tables.Item(1).Cell(nrRows, nrCols).Range.Text = tdItem

                            End If
                        Loop
                    End If
                End If
            Loop


        End If

     Close #2


End Sub