Export multiple Excel columns into individual text files

[br!an]

Hi friends, I require your brians

I have a challenge I'm currently unable to solve with the wisdom already found on this forum. I want to;

• create from columns separate text files (example; 7 columns results in 7 files)
• name of the text file is retrieved from the first cell in column
• generated file should be UTF-8
• be able to select the destination folder when running the script

With below first code snippet I am able to generate multiple files, but not in UTF-8. With the second snippet I am able to generate UTF-8 files, but with all the data in one file. My skills do not allow me to combine the two to have it all. I am not sure how I can use the CreateObject("ADODB.Stream").Stream") to work with export of multiple files based on multiple columns. Can you please help?

Sub SaveValueToText()
Dim xFRNum, xFCNum As Long
Dim xStrDir As String
Dim xMaxR, xMaxC As Integer
Dim xCells As Range
Dim xIntX As Long
Dim xObjFD As FileDialog
Set xObjFD = Application.FileDialog(msoFileDialogFolderPicker)
With xObjFD
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count > 0 Then
            xStrDir = .SelectedItems.Item(1) & Application.PathSeparator
        Else
            Exit Sub
        End If
End With
Set xCells = ActiveSheet.Cells
xMaxR = xCells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
xMaxC = xCells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
For xFCNum = 1 To xMaxC
    Open xStrDir & ActiveSheet.Cells(1, xFCNum).Text & ".txt" For Output As #1
        For xFRNum = 2 To xMaxR
            Print #1, Cells(xFRNum, xFCNum).Value
        Next xFRNum
    Close #1
Next
End Sub
'source: https://www.extendoffice.com/documents/excel/5355-export-excel-columns-to-individual-text-files.html#a1

Sub ColumnsToFileUTF()
    Dim xFCNum As Long, xStrDir, xFRNum() As String
    Dim xMaxR, xMaxC As Integer
    Dim xCells As Range
    Set xObjFD = Application.FileDialog(msoFileDialogFolderPicker)
    With xObjFD
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count > 0 Then
            xStrDir = .SelectedItems.Item(1) & Application.PathSeparator
        Else
            Exit Sub
        End If
    End With
    Set xCells = ActiveSheet.Cells
        xMaxR = xCells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        xMaxC = xCells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    With Cells(1).CurrentRegion
        ReDim xFRNum(1 To xMaxR)
        For xFCNum = 1 To xMaxC
            xFRNum(xFCNum) = Join(Application.Transpose(.Columns(xFCNum).Value), vbNewLine)
        Next
    End With
    With CreateObject("ADODB.Stream")
        .Charset = "UTF-8"
        .Open
        .WriteText Join(xFRNum, vbCrLf)
        .SaveToFile xStrDir & ActiveSheet.Cells(1, xFCNum).Text & ".json", 2
        .Close
    End With
End Sub

'source: https://chandoo.org/forum/threads/export-multiple-columns-to-text-file.28570/