Read unicode from html file by VBA

[morningstar1001]

Hi everyone,

I need to extract the description text from a lot of html files. So I use this code to open and read the text from the html files.

myFile = myPath & Filename
    
    Open myFile For Input As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
    Do Until EOF(1)
        Line Input [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] , textline
        posContent = InStr(1, textline, "title-detail")
        If posContent > 0 Then
            Sheets("data").Cells(j, 3) = textline
        End If
        
    Loop
    Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL]

It worked, but the description text which I need to collect is not UTF-8 and become "Nội thất văn phòng"

So is there any other way to extract correct data?

Thanks.

 

[ParamRay]

Function ExtractTitleDetail(strHtmlFilePath As String) As String
  Const TristateTrue = -1 ' Opens the file as Unicode
  Dim strLineOfText As String
  Dim objFileSys As Object
  Dim objStream As Object
  
  On Error GoTo ErrHandler
  Set objFileSys = CreateObject("Scripting.FileSystemObject")
  Set objStream = objFileSys.OpenTextFile(strHtmlFilePath, Format:=TristateTrue)
  
  Do Until objStream.AtEndOfStream
    strLineOfText = objStream.ReadLine()
    If InStr(1, strLineOfText, "title-detail", vbTextCompare) > 0 Then
      ExtractTitleDetail = strLineOfText
      GoTo ExitProc
    End If
  Loop
  
ExitProc:
  On Error Resume Next
  objStream.Close
  Set objStream = Nothing
  Set objFileSys = Nothing
  Exit Function
  
ErrHandler:
  ExtractTitleDetail = vbNullString
  Resume ExitProc
End Function

 

[morningstar1001]

Thanks for your help.
I tried with your code but the strLineOfText = "?????????".

However, I already found another solution using ADODB.Stream which work perfectly. Here the code just in case someone may need it.

 Dim adoStream As ADODB.Stream
    Dim var_String As Variant

    Set adoStream = New ADODB.Stream
    adoStream.Charset = "UTF-8"
    adoStream.Open
    adoStream.LoadFromFile myFile 'change this to point to your text file
  
    var_String = Split(adoStream.ReadText, vbCrLf) 'split entire file into array - lines delimited by CRLF
    
    For k = LBound(var_String) To UBound(var_String)
        textline = var_String(k)
        posContent = InStr(1, textline, "title-detail")
        If posContent > 0 Then
            Sheets("data2").Cells(j, 3) = textline
        End If
    Next k

 

[ParamRay]

Thanks for your help.
I tried with your code but the strLineOfText = "?????????".

However, I already found another solution using ADODB.Stream which work perfectly. Here the code just in case someone may need it.

 Dim adoStream As ADODB.Stream
    Dim var_String As Variant

    Set adoStream = New ADODB.Stream
    adoStream.Charset = "UTF-8"
    adoStream.Open
    adoStream.LoadFromFile myFile 'change this to point to your text file
  
    var_String = Split(adoStream.ReadText, vbCrLf) 'split entire file into array - lines delimited by CRLF
    
    For k = LBound(var_String) To UBound(var_String)
        textline = var_String(k)
        posContent = InStr(1, textline, "title-detail")
        If posContent > 0 Then
            Sheets("data2").Cells(j, 3) = textline
        End If
    Next k

You said mine didn't work, but you stated in the title that the file is encoded as unicode rather than utf-8. If that was indeed the case, mine works fine.