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 |
VBA Code:
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