View Single Post
  #8   Report Post  
Posted to microsoft.public.excel.programming
Dave Peterson Dave Peterson is offline
external usenet poster
 
Posts: 35,218
Default Converting Excel xls to .csv

There are other ways to create .csv files.

This is an alternative.

Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim wks As Worksheet
Dim MyPath As String

MyPath = ActiveWorkbook.Path

For Each wks In ActiveWorkbook.Worksheets
wks.Copy 'copies to a new workbook

With Application.ActiveSheet
Application.DisplayAlerts = False
.Parent.SaveAs Filename:=MyPath & "\" & .Name, _
FileFormat:=xlCSV
Application.DisplayAlerts = True
.Parent.Close savechanges:=False
End With
Next wks
End Sub



dream big wrote:

hello quartz,
i want to convert my excel sheets to csv format. i have seen the
coding you had given for the purpose.
1) can you kindly provide me with some documentation of the
coding(means which variable is for what purpose).
2) Also i want to know where this coding shud be run (in excel) how ?

many thanks and regards
ekta

"quartz" wrote:

I e-mailed it and I'm posting it below in case anyone else is looking for
something similar:

Public Function ArrayToTextFileCSV(argFullNameDestinCSV As String,
argSheetArray As Variant)
'WRITE THE ARRAY OUT INTO A CSV TEXT FILE;
Dim iFileNumberDestin As Integer
Dim sLine As String
Dim lS As Long
Dim vaData() As Variant
Dim lF As Long
Dim lR As Long
Dim sItem As String
iFileNumberDestin = FreeFile() 'get free file number and open a text file
Open argFullNameDestinCSV For Append As #iFileNumberDestin
For lS = 1 To UBound(argSheetArray) 'write all data from an array into the
text file
Sheets(argSheetArray(lS)).Activate
If lS = 1 Then vaData = ActiveSheet.UsedRange.Value
If lS 1 Then vaData = ActiveSheet.UsedRange.Offset(1,
0).Resize(ActiveSheet.UsedRange.Rows.Count - 1,
ActiveSheet.UsedRange.Columns.Count).Value
For lR = 1 To UBound(vaData, 1)
For lF = 1 To UBound(vaData, 2)
sItem = vaData(lR, lF)
If Trim(sItem) = "" Then
sLine = sLine & """" & sItem & """" & ","
ElseIf Trim(sItem) < "" Then
If InStr(1, sItem, """", vbTextCompare) < 0 Then 'replace
"" with '
sLine = sLine & """" & Replace(sItem, Chr(34), Chr(39))
& """" & ","
Else
sLine = sLine & """" & sItem & """" & ","
End If
End If
Next lF
sLine = Left(sLine, Len(sLine) - 1) & vbCrLf
Print #iFileNumberDestin, sLine;
sLine = ""
Next lR
Next lS
Close #iFileNumberDestin
End Function

Hope this helps.

"James Puglisi" wrote:

Yes, That would be great. Could you send it to my email addy:

--
JimmyP


"quartz" wrote:

It looks ugly, but I have a rather large function that you can call that
writes all Excel data into a csv and runs pretty fast. +/- 30,000 records by
21 columns in less than 1 minute. It uses the Open...For Append method.

You call this function and feed it the full path and name of the desired csv
and an array of sheet names. All the sheets must be formatted alike (i.e.
columns in the same order, etc.). Or the sheet array can include only one
sheet.

All data is surrounded by double quotes and separated by commas. The data is
semi-cleaned up on the fly (i.e. existing double quotes are replaced with
single).

If you want this sort of solution, I can post it. Post back if you would
like it.

"James Puglisi" wrote:

I am trying to convert an excel spreadsheet to csv format, but when I do I
lose all the leading zeros. The zeros are important for several reasons one
being the employees Social Security Number. Any ideas?
--
JimmyP


--

Dave Peterson