Export in tilde delimited - excel

Question

I first create files in Excel. This macro saves all sheets into separate tab delimited text files.
How can I save with a tilde "~" instead of a tab?
Sub newworkbooks()
Dim Sheet As Worksheet, SheetName$, MyFilePath$, N&
MyFilePath$ = ActiveWorkbook.Path & "\" & _
Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
With Application
.ScreenUpdating = False
.DisplayAlerts = False
' End With
On Error Resume Next '<< a folder exists
MkDir MyFilePath '<< create a folder
For N = 1 To Sheets.Count
Sheets(N).Activate
SheetName = ActiveSheet.Name
Cells.Copy
Workbooks.Add (xlWBATWorksheet)
With ActiveWorkbook
With .ActiveSheet
.Paste
.Name = SheetName
[A1].Select
End With
'save book in this folder
.saveas Filename:=MyFilePath _
& "\PO" & SheetName & ".txt", FileFormat:=xlTextWindows
.Close SaveChanges:=True
End With
.CutCopyMode = False
Next
End With
Sheet1.Activate
End Sub
Instead of looking like the following
this is a test
it should look like this
this~is~a~test

Answer 1

Here's one approach, which would be easy to modify to suit - this gives you control over the character set and the delimiter:
https://excel.solutions/2014/04/using-vba-write-excel-data-to-text-file/
Sub WriteTextFile()
Dim rng As Range, lRow As Long
Dim stOutput As String, stNextLine As String, stSeparator As String
Dim stFilename As String, stEncoding As String
Dim fso As Object
'-------------------------------------------------------------------------------------
'CHANGE THESE PARAMETERS TO SUIT
Set rng = ActiveSheet.UsedRange 'this is the range which will be written to text file
stFilename = "C:\Temp\TextOutput.txt" 'this is the text file path / name
stSeparator = vbTab 'e.g. for comma seperated value, change this to ","
stEncoding = "UTF-8" 'e.g. "UTF-8", "ASCII"
'-------------------------------------------------------------------------------------
For lRow = 1 To rng.Rows.Count
If rng.Columns.Count = 1 Then
stNextLine = rng.Rows(lRow).Value
Else
stNextLine = Join$(Application.Transpose(Application.Transpose(rng.Rows(lRow).Value)), stSeparator)
End If
If stOutput = "" Then
stOutput = stNextLine
Else
stOutput = stOutput & vbCrLf & stNextLine
End If
Next lRow
Set fso = CreateObject("ADODB.Stream")
With fso
.Type = 2
.Charset = stEncoding
.Open
.WriteText stOutput
.SaveToFile stFilename, 2
End With
Set fso = Nothing
End Sub
I'm sure you could adapt that to loop through your worksheets, and output the UsedRange of each.
EDIT:
Here's how to adapt it to use tilde as separator, and loop through each worksheet;
Sub OutputAllSheetsTildeSeparated()
Dim rng As Range, lRow As Long
Dim stOutput As String, stNextLine As String, stSeparator As String
Dim stFilepath As String, stFilename As String, stEncoding As String
Dim ws As Worksheet
Dim fso As Object
stFilepath = ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
stSeparator = "~"
stEncoding = "UTF-8"
If Dir(stFilepath, vbDirectory) = vbNullString Then MkDir stFilepath
For Each ws In ThisWorkbook.Worksheets
Set rng = ws.UsedRange
stFilename = stFilepath & "\PO" & ws.Name & ".txt"
For lRow = 1 To rng.Rows.Count
If rng.Columns.Count = 1 Then
stNextLine = rng.Rows(lRow).Value
Else
stNextLine = Join$(Application.Transpose(Application.Transpose(rng.Rows(lRow).Value)), stSeparator)
End If
If stOutput = "" Then
stOutput = stNextLine
Else
stOutput = stOutput & vbCrLf & stNextLine
End If
Next lRow
Set fso = CreateObject("ADODB.Stream")
With fso
.Type = 2
.Charset = stEncoding
.Open
.WriteText stOutput
.SaveToFile stFilename, 2
End With
Set fso = Nothing
Next ws
End Sub