How to export Excel data into multiple txt files

[Soczuss]

Hello,
I have a specific need - I have some Excel data files, each with Column A (name of the customer) and Column B (text message to a customer). Each file consists of 100-2000 rows.
I need to make a macro that allows me to export every row to a separate .txt file.
Every text file:
1) is titled the same as value from Column A in the row,
2) contains inside the text from Column B in the row.

How is it possible to do? I'm a total noob in VBA so I have no idea how to do it. Would really appreciate the help. Would be great to allow txt file saving in the same directory as the Excel file.

 

[John_w]

Try this macro, after editing the matchWorkbooks string, which specifies the folder containing the Excel workbooks to export and the wildcard file name of the workbooks to export. As posted, *.xlsx, matches all .xlsx files in the specified folder. The .txt files are created in the same folder.

Note the For i = 2 To UBound(wbData) exports the rows starting at row 2 (I've assumed row 1 is column headers). Change this to For i = 1 To UBound(wbData) to start exporting at row 1.

Also, if the same customer name occurs more than once, only 1 .txt file for that customer is created, overwriting all previous files.

Public Sub Export_Workbooks_Rows_To_Text_Files()
    
    Dim matchWorkbooks As String, workbooksFolder As String
    Dim saveInFolder As String
    Dim workbookFileName As String
    Dim wb As Workbook
    Dim wbData As Variant
    Dim i As Long
    
    matchWorkbooks = "C:\path\to\folder\*.xlsx"   'CHANGE THIS
    
    workbooksFolder = Left(matchWorkbooks, InStrRev(matchWorkbooks, "\"))
    
    saveInFolder = workbooksFolder
    
    Application.ScreenUpdating = False
            
    workbookFileName = Dir(matchWorkbooks)
    Do While workbookFileName <> vbNullString
        Application.StatusBar = "Exporting " & workbooksFolder & workbookFileName
        Set wb = Workbooks.Open(workbooksFolder & workbookFileName, ReadOnly:=True)
        wbData = wb.Worksheets(1).Range("A1").CurrentRegion.Value
        wb.Close False
        For i = 2 To UBound(wbData)
            Open saveInFolder & wbData(i, 1) & ".txt" For Output As #1
            Print #1, wbData(i, 2)
            Close #1
        Next
        workbookFileName = Dir
    Loop
    
    Application.StatusBar = False
    Application.ScreenUpdating = True
    
    MsgBox "Done"
    
End Sub

 

[Soczuss]

Try this macro, after editing the matchWorkbooks string, which specifies the folder containing the Excel workbooks to export and the wildcard file name of the workbooks to export. As posted, *.xlsx, matches all .xlsx files in the specified folder. The .txt files are created in the same folder.

Note the For i = 2 To UBound(wbData) exports the rows starting at row 2 (I've assumed row 1 is column headers). Change this to For i = 1 To UBound(wbData) to start exporting at row 1.

Also, if the same customer name occurs more than once, only 1 .txt file for that customer is created, overwriting all previous files.

Public Sub Export_Workbooks_Rows_To_Text_Files()
   
    Dim matchWorkbooks As String, workbooksFolder As String
    Dim saveInFolder As String
    Dim workbookFileName As String
    Dim wb As Workbook
    Dim wbData As Variant
    Dim i As Long
   
    matchWorkbooks = "C:\path\to\folder\*.xlsx"   'CHANGE THIS
   
    workbooksFolder = Left(matchWorkbooks, InStrRev(matchWorkbooks, "\"))
   
    saveInFolder = workbooksFolder
   
    Application.ScreenUpdating = False
           
    workbookFileName = Dir(matchWorkbooks)
    Do While workbookFileName <> vbNullString
        Application.StatusBar = "Exporting " & workbooksFolder & workbookFileName
        Set wb = Workbooks.Open(workbooksFolder & workbookFileName, ReadOnly:=True)
        wbData = wb.Worksheets(1).Range("A1").CurrentRegion.Value
        wb.Close False
        For i = 2 To UBound(wbData)
            Open saveInFolder & wbData(i, 1) & ".txt" For Output As #1
            Print #1, wbData(i, 2)
            Close #1
        Next
        workbookFileName = Dir
    Loop
   
    Application.StatusBar = False
    Application.ScreenUpdating = True
   
    MsgBox "Done"
   
End Sub

Thank you so much!