Exporting utf-8 from Excel

[Eben]

I need some help figuring out how to export data from column-B for each filename in column-A. At the moment It will only export last row of Column-B for each filename in column-A.

A	B
Filename-1	Data-a
Filename-1	Data-b
Filename-1	Data-c
Filename-2	Data-e
Filename-2	Data-f

Option Explicit
Sub WriteUtf8()
Dim filePath As String
Dim charToEncode As String
Dim success As Boolean
Dim r As Long
Dim oldFn As String
Dim currFn As String
Dim lastRow As Long

        lastRow = Cells(Rows.Count, "A").End(xlUp).row

        For r = 1 To lastRow
            currFn = Cells(r, "A").Value
        If currFn <> oldFn Then
            oldFn = currFn
        
            If r > 1 Then Close
            
    filePath = ThisWorkbook.Path & "\html\" & currFn & ".html"
    
         End If
      
            charToEncode = Cells(r, "B").Value
            success = ConvertSave(charToEncode, filePath)
       Next
    Close
       
    If success Then
        MsgBox ("Done")
    Else
        MsgBox ("Error")
    End If
    

End Sub


Function ConvertSave(ByVal charToEncode As String, _
    ByVal filePath As String) As Boolean

    Dim fsT As Object
    Dim adodbStream  As Object

    On Error GoTo Err:
    Set adodbStream = CreateObject("ADODB.Stream")
    With adodbStream
        .Type = 2 
        .Charset = "utf-8" 
        .Open
        .WriteText charToEncode
        .SaveToFile filePath, 2 
    End With

    ConvertSave = True

    On Error GoTo 0

    Exit Function

Err:
ConvertSave = False

End Function

 

[GWteB]

Hi Eben, welcome to MrExcel.

To get straight to the point and to be clear, I am not familiar with ADO, however .... from your code it becomes clear to me what causes the effect as you described.
For every row in your sheet the ConvertSave function procedure is invoked. That function creates on every run a new stream object. Each of those stream objects cannot be aware of the existence of the other stream objects. If a certain file name is used for more than one stream object, the stream which was written to last remains.
Long story short, if the linked file name doesn't change, data will be overwritten.

While it would have been possible to rewrite your ConvertSave function, I chose to work around your problem by deploying a class. Hopefully this is of some help.

This code goes in a standard module:

Sub WriteUtf8()
    
    Dim oADO        As clsADODBStream
    Dim ErrMsg      As VbMsgBoxResult
    Dim rng         As Range
    Dim c           As Range
    Dim sFile       As String
    Dim bFirstTurn  As Boolean
    
    On Error GoTo Sub_ERR

    With ActiveSheet
        Set rng = .Range(.Cells(1, "A"), .Cells(.Rows.Count, "A").End(xlUp))
    End With
 
    bFirstTurn = True
    For Each c In rng
        sFile = ThisWorkbook.Path & "\html\" & c.Value & ".html"
        If Not bFirstTurn Then
            If StrComp(c.Value, c.Offset(-1, 0).Value, vbTextCompare) <> 0 Then
                oADO.SaveAndClose
                Set oADO = New clsADODBStream
                oADO.OpenStream sFile
            End If
        Else
            Set oADO = New clsADODBStream
            oADO.OpenStream sFile
            bFirstTurn = False
        End If
        oADO.WriteText c.Offset(0, 1).Value
    Next c
    oADO.SaveAndClose
    Set oADO = Nothing
    
    If ErrMsg = 0 Then
        MsgBox "Done"
    End If
    Exit Sub

Sub_ERR:
    ErrMsg = MsgBox("Error " & err.Number & vbNewLine & _
                    "Source: " & err.Source & vbNewLine & _
                    "Description: " & err.Description, vbCritical + vbAbortRetryIgnore, "WriteUtf8")
    err.Clear
    If ErrMsg = vbAbort Then
        Exit Sub
    ElseIf ErrMsg = vbRetry Then
        Resume
    ElseIf ErrMsg = vbIgnore Then
        Resume Next
    End If
End Sub

This code goes in a class module, which should be renamed to clsADODBStream:

Option Explicit

Private oStream         As Object
Private sFullFileName   As String

Private Sub Class_Terminate()
    Set oStream = Nothing
End Sub

Public Sub OpenStream(ByVal argFileName As String)
    sFullFileName = argFileName
    Set oStream = CreateObject("ADODB.Stream")
    With oStream
        .Type = 2
        .Charset = "utf-8"
        .Open
    End With
End Sub

Public Sub WriteText(ByVal argTxt As String)
    If Not oStream Is Nothing Then
        oStream.WriteText argTxt
    End If
End Sub

Public Sub SaveAndClose()
    Dim lErr As Long
    If Not oStream Is Nothing Then
        On Error Resume Next
        oStream.SaveToFile sFullFileName, 2
        lErr = err.Number
        oStream.Close
        On Error GoTo 0
        If lErr > 0 Then
            err.Raise vbError + lErr, "ADODBStream Class", "Saving to file failed:" & vbNewLine & sFullFileName
        End If
        Set oStream = Nothing
    End If
End Sub

 

[Eben]

Amazing! That is exactly what I was looking for.
It was so nice of you to reply and find the work around.
I am so happy to find such a welcoming community.
Thank you so much for taking the time, I really appreciate it.

Happy Holidays and God Bless!

 

[GWteB]

You are welcome. Thanks for letting me know and same wishes to you!