Help for macro to export to text file with certain amount of spaces.

[abjac]

Hi I would like if some can help me find a macro, which can convert a excel file to text file. And that the output text file look special. Need for and special application, to upload it to.

There is 3 columns in sheet 2. I want all lines to come out without spaces, the only special is that i want to have the - replaced with 183 blank spaces.

So the outlook file will look like this example.

200100000365595200019100014219920131120-40000041179  With no spaces
200330000001895490590500011996920131120   exactly 183 blank spaces             40000106363  
200330000001895490590500011996920131120   exactly 183 blank spaces             40000106363
200330000001895490590500011996920131120   exactly 183 blank spaces             40000106363

I have this below code for take it out to textfile but not sure it will work. It make spaces between all columns.

So any other macro would be great to have. I have attached a test sheet, where you can see the file before the conversion to text.

Have a look please.

Sincerely

Abjac

Sub DoTheExport()
Sheets(2).Activate
Dim FileName As Variant
    Dim Sep As String
    FileName = Application.GetSaveAsFilename(InitialFileName:=vbNullString, FileFilter:="Text Files (*.txt),*.txt")
    If FileName = False Then
        ''''''''''''''''''''''''''
        ' user cancelled, get out
        ''''''''''''''''''''''''''
        Exit Sub
    End If
    Sep = Application.InputBox("                 ", Type:=2)
    If Sep = vbNullString Then
        ''''''''''''''''''''''''''
        ' user cancelled, get out
        ''''''''''''''''''''''''''
        Exit Sub
    End If
    Debug.Print "FileName: " & FileName, "Separator: " & Sep
    ExportToTextFile FName:=CStr(FileName), Sep:=CStr(Sep), _
       SelectionOnly:=False, AppendData:=True
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' END DoTheExport


' This exports a sheet or range to a text file, using a
' user-defined separator character.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub ExportToTextFile(FName As String, _
    Sep As String, SelectionOnly As Boolean, _
    AppendData As Boolean)

Dim WholeLine As String
Dim FNum As Integer
Dim RowNdx As Long
Dim ColNdx As Integer
Dim StartRow As Long
Dim EndRow As Long
Dim StartCol As Integer
Dim EndCol As Integer
Dim CellValue As String


Application.ScreenUpdating = False
On Error GoTo EndMacro:
FNum = FreeFile

If SelectionOnly = True Then
    With Selection
        StartRow = .Cells(1).Row
        StartCol = .Cells(1).Column
        EndRow = .Cells(.Cells.Count).Row
        EndCol = .Cells(.Cells.Count).Column
    End With
Else
    With ActiveSheet.UsedRange
        StartRow = .Cells(1).Row
        StartCol = .Cells(1).Column
        EndRow = .Cells(.Cells.Count).Row
        EndCol = .Cells(.Cells.Count).Column
    End With
End If

If AppendData = True Then
    Open FName For Append Access Write As #FNum
Else
    Open FName For Output Access Write As #FNum
End If

For RowNdx = StartRow To EndRow
    WholeLine = ""
    For ColNdx = StartCol To EndCol
        If Cells(RowNdx, ColNdx).Value = "" Then
            CellValue = Chr(34) & Chr(34)
        Else
           CellValue = Cells(RowNdx, ColNdx).Value
        End If
        WholeLine = WholeLine & CellValue & Sep
    Next ColNdx
    WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
    Print #FNum, WholeLine
Next RowNdx

EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #FNum
Sheets(1).Activate

End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' END ExportTextFile