VBA to export excel cell data into .txt files

Question

I have an excel spreadsheet that has some long text in cells of column C and approx. 400 rows.

You can see an example lay out here: Dummy data example

What I would like to do is extract the data in each cell of column C into a .txt file of its own. The file name for each .txt file would be composed of data from other columns to be formatted like Chris_17-08-2021 where Chris = name from column D and the date is extracted form column B.

I am absolutely lost with the VBA code I have looked at on other sites. Any help would be really appreciated - even if pointing me in the direction of the right resources.

Thanks in advance :D

Answer 1

Export Cell Contents to Text Files

• Adjust the values in the constants section
• The destination folder (dFolderPath) will be created if it doesn't exist.
• I have chosen to use a destination folder (dFolderName) located in the folder of ThisWorkbook (the workbook containing this code). You could hardcode it if necessary, e.g. dFolderPath = "C:\Test\" when you wouldn't need dFolderName anymore. Caution: Don't forget the trailing backslash (\).
• The files will be overwritten (without confirmation) each time when running the code.

Option Explicit

Sub exportData()
    
    Const sName As String = "Sheet1"
    Const dFolderName As String = "Text Files"
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet: Set ws = wb.Worksheets(sName)
    Dim rg As Range: Set rg = ws.Range("A1").CurrentRegion.Resize(, 4)
    Dim Data As Variant: Data = rg.Resize(rg.Rows.Count - 1).Offset(1).Value
    
    Dim dFolderPath As String:
    dFolderPath = ThisWorkbook.Path & "\" & dFolderName & "\"
    
    On Error Resume Next
    MkDir dFolderPath
    On Error GoTo 0
    
    Dim Num As Long: Num = FreeFile()
    Dim r As Long
    Dim dFileName As String
    For r = 1 To UBound(Data, 1)
        dFileName = Data(r, 4) & "_" & Format(Data(r, 2), "dd-mm-yyyy") & ".txt"
        Open dFolderPath & dFileName For Output As #Num
        Print #Num, Data(r, 3)
        Close #Num
    Next r
    
End Sub