Extract text from column D to txt files and name files based on content of column C - vba

Question

Apologies for a noob question but I've been fiddling around with this code:
https://stackoverflow.com/a/7151963/3672159
and can't seem to get it modified to do the following (very slight modifications of the code above):
Take as input a worksheet that is called "Export Data" (rather than "Sheet1" as in the existing code; the space seems to cause problems)
Automatically create an empty file for each cell of column D, which should have as its content the value of the respective D cell (same as with the "Disclaimer" data in the code above)
Name each file based on the values of the corresponding C cells (so for me it's name=column C, content=column D rather than B and A in the original code).
I've modified the code as follows:
Sub ExportFiles()
Dim sExportFolder, sFN
Dim rStoreId As Range
Dim rAbstract As Range
Dim oSh As Worksheet
Dim oFS As Object
Dim oTxt As Object
'sExportFolder = path to the folder you want to export to
'oSh = The sheet where your data is stored
sExportFolder = "my file path\txt"
Set oSh = Export Data
Set oFS = CreateObject("Scripting.Filesystemobject")
For Each rStoreId In oSh.UsedRange.Columns("D").Cells
Set rAbstract = rStoreId.Offset(, -1)
'Add .txt to the article name as a file name
sFN = rStoreId.Value & ".txt"
Set oTxt = oFS.OpenTextFile(sExportFolder & "\" & sFN, 2, True)
oTxt.Write rAbstract.Value
oTxt.Close
Next
End Sub
The only thing this does (as does the original code) is create one empty unnamed txt file.
Any help is greatly appreciated!

Answer 1

Try this...
Sub ExportFiles()
Dim sExportFolder, sFN
Dim rStoreId As Range
Dim rAbstract As Range
Dim oSh As Worksheet
Dim oFS As Object
Dim oTxt As Object
'sExportFolder = path to the folder you want to export to
'oSh = The sheet where your data is stored
sExportFolder = "C:\Users\Rich\Desktop"
Set oSh = ThisWorkbook.Sheets("Export Data")
Set oFS = CreateObject("Scripting.Filesystemobject")
For Each rStoreId In oSh.Columns("D").Cells
If IsEmpty(rStoreId.Value) Then
Exit For
End If
Set rAbstract = rStoreId.Offset(, -1)
'Add .txt to the article name as a file name
sFN = rStoreId.Value & ".txt"
Set oTxt = oFS.OpenTextFile(sExportFolder & "\" & sFN, 2, True)
oTxt.Write rAbstract.Value
oTxt.Close
Next
End Sub
You need to select the sheet correctly with (Assuming it is within the same workbook as the code)...
Set oSh = ThisWorkbook.Sheets("Export Data")
And I changed how you were iterating through the range...
For Each rStoreId In oSh.Columns("D").Cells
If IsEmpty(rStoreId.Value) Then
Exit For
End If
Next
This just goes through column D's cells until it hits an empty one, I couldn't quite get it working using UsedRange and this (more old skool) method works in my tests.

Answer 2

This works for me. It writes each value in cells in column D to a text file that is named based on the entry in column C and puts all text files in user specified folder:
Sub ExportFiles()
Dim exportFolder As String
Dim fso As FileSystemObject
Dim stream As TextStream
Dim cl As Range
exportFolder = "C:\User\ExportFolder" //Add you folder path here
Set fso = New FileSystemObject
For Each cl In Worksheets("Export Data").UsedRange.Columns("D").Cells
Set stream = fso.CreateTextFile(filepath & "\" & cl.Offset(0, -1).Value & ".txt", 2, True)
stream.Write cl.Value
stream.Close
Next
End Sub