VBA Worksheets to text files

[Carey22]

Hi

I'm new to macros and I've found the VBA below which converts a worksheet containing one cell of text i.e. cell A1, with commas and quotes to a text file without adding double quotes which is what I need. However, I would like to repeat this for hundreds of worksheets and use the worksheet name as the file name. Is there a way to modify the code below to do this as currently it just creates one text file and when run writes over the previous text file.

All the worksheets I wish to convert contain one cell of text only.

<code style="margin: 0px; padding: 0px; border: 0px; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; white-space: inherit;">Public Sub TextNoModification()
Const DELIMITER As String = "," 'or "|", vbTab, etc.
Dim myRecord As Range
Dim myField As Range
Dim nFileNum As Long
Dim sOut As String

nFileNum = FreeFile
Open "Test.txt" For Output As #nFileNum
For Each myRecord In Range("A1:A" & _
Range("A" & Rows.Count).End(xlUp).Row)
With myRecord
For Each myField In Range(.Cells(1), _
Cells(.Row, Columns.Count).End(xlToLeft))
sOut = sOut & DELIMITER & myField.Text
Next myField
Print #nFileNum, Mid(sOut, 2)
sOut = Empty
End With
Next myRecord
Close #nFileNum
End Sub</code>Thanks

 

[Joe4]

Try this:

Public Sub TextNoModification()

    Const DELIMITER As String = "," 'or "|", vbTab, etc.
    Dim myRecord As Range
    Dim myField As Range
    Dim nFileNum As Long
    Dim sOut As String
    Dim ws As Worksheet

    For Each ws In Worksheets
        ws.Activate
        nFileNum = FreeFile
        Open ws.Name & ".txt" For Output As #nFileNum
        For Each myRecord In Range("A1:A" & _
            Range("A" & Rows.Count).End(xlUp).Row)
            With myRecord
                For Each myField In Range(.Cells(1), _
                    Cells(.Row, Columns.Count).End(xlToLeft))
                    sOut = sOut & DELIMITER & myField.Text
                Next myField
                Print #nFileNum, Mid(sOut, 2)
                sOut = Empty
            End With
        Next myRecord
        Close #nFileNum
    Next ws
    
End Sub

 

[Carey22]

I can't thank you enough, I've been trying to find a solution for ages and this works perfectly! You're a superstar

 

[Carey22]

I spoke to soon, the above worked when I tested two worksheets each containing content in cell A1 such as "test". However, when I tried it in my actual worksheet I received the following error message

'Run-time error 52'
Bad file name or number

None of the worksheet names have reserved characters such as * " or / they are just hotel names with spaces so Im not sure why this message has appeared. Also I noticed that after the error message appeared the macro had actually saved only one or two worksheets, after several tries I realised it was worksheets beginning with the letter 'A', Im not sure if this means anything.

I found the code below actually works perfectly to convert a hundred worksheets to text files but it adds double quotes. If you cant spot the error in the code above can you amend the code below to include the DELIMITER line?

Sub ExportSheetsToCSV()
Dim xWs As Worksheet
Dim xtxtFile As String
For Each xWs In Application.ActiveWorkbook.Worksheets
xWs.Copy
xtxtFile = xWs.Name & ".html"
Application.ActiveWorkbook.SaveAs Filename:=xtxtFile, _
FileFormat:=xlCSV, CreateBackup:=False
Application.ActiveWorkbook.Saved = True
Application.ActiveWorkbook.Close
Next
End Sub

 

[Joe4]

What exactly are the name of your sheets?
What format are you trying to export to? CSV or HTML?