How to convert XLS to a CSV file???

G

Guest

How do you convert a XLS file with 36 tabs to a CSV file using pipe(|)
instead of commas(,) and some of the values in the spreadsheet has commas so
those need to be put into quotes(") so they are not a comma delimited, by a
push of a button? I have to have this into a macro, because the company is
too cheap to buy software, like CONVERT XLS, that would do all of this for
me.

Thanks in advance
cg
 
G

Guest

Thanks but this is not what i'm looking for. I have a XLS file with 36 tabs,
i need a loop in the macro to export each tab to a CSV file that will save
the csv files by the tab names, all of this down by one click of a button(
one macro) - Thanks
 
J

JE McGimpsey

Wrap the code at that page in a loop:

Dim wsSheet As Worksheet
For Each wsSheet In Worksheets
nFileNum = FreeFile
Open wsSheet.Name & ".csv" For Output As #nFileNum
'For Each myRecord In....
Next wsSheet
 
G

Guest

that works great, how can i incorporate this into the rest of my code? ( you
can tell i'm a newby at this). the following is one macro. thanks

Public Sub DoTheExport()
Dim FName As Variant
Dim Sep As String

FName = Application.GetSaveAsFileName()
If FName = False Then
MsgBox "You didn't select a file"
Exit Sub
End If

Sep = InputBox("Enter a single delimiter character (e.g., comma or
semi-colon)", _
"Export To Text File")

ExportToTextFile CStr(FName), Sep, _
MsgBox("Do You Want To Export The Entire Worksheet?", _
vbYesNo, "Export To Text File") = vbNo
End Sub

-------------------------------------

Public Sub ExportToTextFile(FName As String, _
Sep As String, SelectionOnly 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

Open FName For Output Access Write As #FNum

For RowNdx = StartRow To EndRow
WholeLine = ""
For ColNdx = StartCol To EndCol
If Cells(RowNdx, ColNdx).Value = "" Then
CellValue = Chr(34) & Chr(34)
Else
CellValue = _
Application.WorksheetFunction.Text _
(Cells(RowNdx, ColNdx).Value, _
Cells(RowNdx, ColNdx).NumberFormat)
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

End Sub
 
G

Guest

This is what i have created so far with some help of course. This code will
create a file for every tab (36 of them) and will input the data of what ever
sheet i have open into all of the files, instead of pulling data from each
tab. Can anyone help me to fix this? I also want to thank McGimpsey for
their help.


Public Sub DoTheExport()
Dim FName As Variant
Dim Sep As String
Dim wsSheet As Worksheet
Dim nFileNum As Integer

Sep = InputBox("Enter a single delimiter character (e.g., comma or
semi-colon)", _
"Export To Text File")


For Each wsSheet In Worksheets
nFileNum = FreeFile
Open wsSheet.Name & ".csv" For Output As #nFileNum
ExportToTextFile CStr(nFileNum), Sep, False
'_
' MsgBox("Do You Want To Export The Entire Worksheet?", _
' vbYesNo, "Export To Text File") = vbNo
Close nFileNum
Next wsSheet

End Sub



Public Sub ExportToTextFile(nFileNum As Integer, _
Sep As String, SelectionOnly 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:

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

For RowNdx = StartRow To EndRow
WholeLine = ""
For ColNdx = StartCol To EndCol
If Cells(RowNdx, ColNdx).Value = "" Then
CellValue = ""
Else
CellValue = _
Application.WorksheetFunction.Text _
(Cells(RowNdx, ColNdx).Value, _
Cells(RowNdx, ColNdx).NumberFormat)
End If
WholeLine = WholeLine & CellValue & Sep
Next ColNdx
WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
Print #nFileNum, WholeLine
Next RowNdx

EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True

End Sub
 
D

Dave Peterson

JE's code uses the activesheet in this line:
With ActiveSheet.UsedRange

You could either pass it the worksheet to work on or you could just activate
each sheet before you call that macro:

....
For Each wsSheet In Worksheets
wsSheet.Activate '<---- Added
nFileNum = FreeFile
....

And it worked ok for me after that.
 
G

Guest

it's amazing how simple that is - Thanks, it worked great. here is the final
code for future references.

Public Sub DoTheExport()
Dim FName As Variant
Dim Sep As String
Dim wsSheet As Worksheet
Dim nFileNum As Integer


Sep = InputBox("Enter a single delimiter character (e.g., comma or
semi-colon)", _
"Export To Text File")


For Each wsSheet In Worksheets
wsSheet.Activate
nFileNum = FreeFile
Open wsSheet.Name & ".csv" For Output As #nFileNum
ExportToTextFile CStr(nFileNum), Sep, False
'_
' MsgBox("Do You Want To Export The Entire Worksheet?", _
' vbYesNo, "Export To Text File") = vbNo
Close nFileNum
Next wsSheet

End Sub



Public Sub ExportToTextFile(nFileNum As Integer, _
Sep As String, SelectionOnly As Boolean)

Dim WholeLine As String
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:

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

For RowNdx = StartRow To EndRow
WholeLine = ""
For ColNdx = StartCol To EndCol
If Cells(RowNdx, ColNdx).Value = "" Then
CellValue = ""
Else
CellValue = _
Application.WorksheetFunction.Text _
(Cells(RowNdx, ColNdx).Value, _
Cells(RowNdx, ColNdx).NumberFormat)
End If
WholeLine = WholeLine & CellValue & Sep
Next ColNdx
WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
Print #nFileNum, WholeLine
Next RowNdx

EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top