arraysvbastringutf-8

Writing file in UTF-8 format in array


I am trying to extract lines of data's in a file text and save those lines in utf-8 format. But it gives me an error because of the array type. It only accepts string data type.

Sub ReadTextFileDataInExcel()

    Dim TblNum As String
    TblNum = Worksheets("“ü—̓f[ƒ^").Range("A2").Value

    Dim RowNumber   As Long
    Dim TextFile    As String
    Dim LineData    As String
    Dim stemp() As Collection
    Dim Test As Variant
    
    TextFile = ThisWorkbook.path & "\" & TblNum & "\" & "CA003" & "\10_RunScript\20.ExpectResult.sql"
    
    MyDir = ThisWorkbook.path & "\" & TblNum & "\" & "CA003" & "\10_RunScript"
        MyFileName = MyDir & "\40.ExpectResult.sql"
      
    RowNumber = 1
     
    Open TextFile For Input As #1
        Do While Not EOF(1)
            Line Input #1, LineData
            
            If LineData Like "insert*" Then
                Worksheets("40.ExpectResult_TEMP").Range("A" & RowNumber).Value = LineData
                myArray = Array(LineData)
                RowNumber = RowNumber + 1
            End If
            WriteIfFile_utf8 MyFileName, myArray
        Loop
    Close #1
    
            
End Sub

Function WriteIfFile_utf8(strPath As Variant, str As Variant)
    Dim objStream As Object
    Dim utfStr As Variant
    Set objStream = CreateObject("adodb.stream")

    With objStream
        .Type = 2 'adTypeText
        .Charset = "UTF-8"
        .Open
        .writetext str
        .Position = 0
        .Type = 1 'adTypeBinary
        .Position = 3
        utfStr = .Read()
        .Position = 0
        .write utfStr
        .setEOS
        .savetofile strPath, 2
        .Close
    End With
    Set objStream = Nothing
End Function

Solution

  • Microsoft documentation:

    Mid function

        Dim newTxt As String
        Open TextFile For Input As #1
            Do While Not EOF(1)
                Line Input #1, LineData            
                If LineData Like "insert*" Then
                    Worksheets("40.ExpectResult_TEMP").Range("A" & RowNumber).Value = LineData
                    newTxt = newTxt & vbCr & LineData
                    RowNumber = RowNumber + 1
                End If
                WriteIfFile_utf8 MyFileName, Mid(newTxt, 2)
            Loop
        Close #1
    
    Function WriteIfFile_utf8(strPath As String, str As String)
        Dim objStream As Object
        Dim utfStr As Variant
        Set objStream = CreateObject("adodb.stream")
    
        With objStream
            .Type = 2 'adTypeText
            .Charset = "UTF-8"
            .Open
            .writetext str
            .savetofile strPath, 2
            .Close
        End With
        Set objStream = Nothing
    End Function