johnrlalor
New Member
- Joined
- Feb 14, 2014
- Messages
- 40
I use the code below to save a copy of my Excel file as a text file however I now want to save the file as .CSV
I have done this by updating .txt to .csv in the code below however the file is not saved as comma delimited, all columns of data are saved to a single column.
Anyone any ideas?
Sub CopyDataToTextFile()
Dim X As Long, FF As Long, LastCopyRow As Long, DataToOutput As String, Filename As String
'First row of data to be extracted, includes header line for Text file
Const StartRow As Long = 2
On Error Resume Next
LastCopyRow = Columns("A").SpecialCells(xlBlanks)(1).Row - 1
If Err.Number Then LastCopyRow = Cells(Rows.Count, "B").End(xlUp).Row
On Error GoTo 0
For X = StartRow To LastCopyRow
'Resize value is the number of columns to be loaded
DataToOutput = DataToOutput & vbNewLine & Application.Trim(Join(Application.Index(Cells(X, "A").Resize(, 46).Value, 1, 0), vbTab))
Next
DataToOutput = Mid(DataToOutput, Len(vbNewLine) + 1)
Filename = "H:\ " & "_" & Range("A1").Value & Format(Date, "yyyymmdd") & ".txt"
Filename = Application.GetSaveAsFilename(Filename, "Text Files (*.txt), *.txt", 1, "Save")
If Filename <> "False" Then
FF = FreeFile
Open Filename For Output As #FF
Print #FF, DataToOutput
Close #FF
End If
End Sub
I have done this by updating .txt to .csv in the code below however the file is not saved as comma delimited, all columns of data are saved to a single column.
Anyone any ideas?
Sub CopyDataToTextFile()
Dim X As Long, FF As Long, LastCopyRow As Long, DataToOutput As String, Filename As String
'First row of data to be extracted, includes header line for Text file
Const StartRow As Long = 2
On Error Resume Next
LastCopyRow = Columns("A").SpecialCells(xlBlanks)(1).Row - 1
If Err.Number Then LastCopyRow = Cells(Rows.Count, "B").End(xlUp).Row
On Error GoTo 0
For X = StartRow To LastCopyRow
'Resize value is the number of columns to be loaded
DataToOutput = DataToOutput & vbNewLine & Application.Trim(Join(Application.Index(Cells(X, "A").Resize(, 46).Value, 1, 0), vbTab))
Next
DataToOutput = Mid(DataToOutput, Len(vbNewLine) + 1)
Filename = "H:\ " & "_" & Range("A1").Value & Format(Date, "yyyymmdd") & ".txt"
Filename = Application.GetSaveAsFilename(Filename, "Text Files (*.txt), *.txt", 1, "Save")
If Filename <> "False" Then
FF = FreeFile
Open Filename For Output As #FF
Print #FF, DataToOutput
Close #FF
End If
End Sub