Creating Comma Delimited txt file

[zfitzjarrell]

I found some really good code on this board, but it doesn't do exactly what I'm looking for and my attempts to modify the code haven't worked.

I'm trying to created a comma delimited text file. Here is the code I'm working with:

Sub ExportToText()

Dim delimiter As String
Dim quotes As Integer
Dim Returned As String

delimiter = " "

' Specify if you want quotes to surround the cell information
' (0 = no 1 = yes)
quotes = 0

' Call the WriteFile function passing the delimiter and quotes options.
Returned = WriteFile(delimiter, quotes)

' Print a message box indicating if the process was completed.
Select Case Returned
Case "Canceled"
MsgBox "The export operation was canceled."
Case "Exported"
MsgBox "The information was exported."
End Select

End Sub

_______________________________________________________________________

Function WriteFile(delimiter As String, quotes As Integer) As String

' Dimension variables to be used in this function.
Dim CurFile As String
Dim SaveFileName
Dim CellText As String
Dim RowNum As Integer
Dim ColNum As Integer
Dim FNum As Integer
Dim TotalRows As Double
Dim TotalCols As Double
Dim HalfWidth As Integer

' Show Save As dialog box with the .TXT file name as the default.
' Test to see what kind of system this macro is being run on.
If Left(Application.OperatingSystem, 3) = "Win" Then
SaveFileName = Application.GetSaveAsFilename(CurFile, _
"Text Delimited (*.txt), *.txt", , "Export to a Text File")
Else
SaveFileName = Application.GetSaveAsFilename(CurFile, _
"TEXT", , "Text Delimited Exporter")
End If

' Check to see if Cancel was clicked.
If SaveFileName = False Then
WriteFile = "Canceled"
Exit Function
End If
' Obtain the next free file number.
FNum = FreeFile()

' Open the selected file name for data output.
Open SaveFileName For Output As #FNum

' Store the total number of rows and columns to variables.
TotalRows = Selection.Rows.Count
TotalCols = Selection.Columns.Count

' Loop through every cell, from left to right and top to bottom.
For RowNum = 1 To TotalRows
For ColNum = 1 To TotalCols
With Selection.Cells(RowNum, ColNum)
Dim ColWidth As Integer
ColWidth = Application.RoundUp(.ColumnWidth, 0)
' Store the current cells contents to a variable.
If ColWidth < Len(.Text) Then
CellText = Left(.Text, ColWidth)
Else
Select Case .HorizontalAlignment
Case xlRight
CellText = Space(ColWidth - Len(.Text)) & .Text
Case xlCenter
HalfWidth = (ColWidth - Len(.Text)) / 2
CellText = Space(HalfWidth) & .Text & _
Space(ColWidth - Len(.Text) - HalfWidth)
Case Else
CellText = .Text & Space(ColWidth - Len(.Text))
End Select
End If
End With
' Write the contents to the file.
' With or without quotation marks around the cell information.
Select Case quotes
Case vbYes
CellText = Chr(34) & CellText & Chr(34) & delimiter
Case vbNo
End Select
Print #FNum, CellText;

' Update the status bar with the progress.
Application.StatusBar = Format((((RowNum - 1) * TotalCols) _
+ ColNum) / (TotalRows * TotalCols), "0%") & " Completed."

' Loop to the next column.
Next ColNum
' Add a linefeed character at the end of each row.
If RowNum <> TotalRows Then Print #FNum, ""
' Loop to the next row.
Next RowNum

' Close the .prn file.
Close #FNum

' Reset the status bar.
Application.StatusBar = False
WriteFile = "Exported"

End Function

I tried to change the Delimiter part by putting a comma inside the quotes, but it still creates a tab delimited txt file.

Any ideas?

thanks

 

[zfitzjarrell]

anyone have any ideas?

All I really need is someone to take a look at the first section of code and tell me how I can change my delimiter from a tab to a comma

thanks!

 

[Tazguy37]

Did you try putting a "," in here?:

delimiter = " "

 

[acw]

Hi

In the function try changing
Case Else
CellText = .Text & Space(ColWidth - Len(.Text))

to
Case Else
CellText = .Text & "," 'Space(ColWidth - Len(.Text))

This will only work for the else section of the case, so try an example where this will take effect (say data A1:D2 a,b,c,d,e,f,g,h) and if it is effective, then alter the other case statements.


Tony

 

[zfitzjarrell]

Tony,

Your suggestion worked. I'm curious where else I should modify the code though.

Also, do you know of any way to prevent the placement of a comma after the last column like in the example shown below?

00022,1,00017845,00024,Christopher Johnson,
00022,1,00014832,00021,Sami Malota,
00022,1,00017491,00023,Margurite Alyea,
00022,1,00021545,00023,Zach Fitzjarrell,

thanks

 

[acw]

HI

1) You will have to alter all the other parts of the case statement ie everything in

Select Case .HorizontalAlignment 
Case xlRight 
CellText = Space(ColWidth - Len(.Text)) & .Text 
Case xlCenter 
HalfWidth = (ColWidth - Len(.Text)) / 2 
CellText = Space(HalfWidth) & .Text & _ 
Space(ColWidth - Len(.Text) - HalfWidth) 
Case Else 
CellText = .Text & Space(ColWidth - Len(.Text)) 
End Select

All of the items where the space is added will have to be converted to the comma. Also, you may have to change the first part of the encompasing IF statement. Not sure - would have to test.

2) Allow the comma to be added, then remove at the end. Something like

CellText = left(CellText, len(CellText)-1)

Depending on what you do to the other parts of the case statement, you can add this line at the end to remove the trailing commas.


Tony