Export Double Quotes CSV from Specific Sheet

somebody113 · Nov 11, 2011

Crossposted:

http://www.excelforum.com/excel-pro...otes-csv-from-specific-sheet.html#post2640656
http://www.ozgrid.com/forum/showthread.php?t=159930&p=584135#post584135
http://www.mrexcel.com/forum/showthread.php?p=2927315#post2927315

Hey Guys,

Struggling here with the double quotes in CSV. All I want to do is:

1. Export double quotes properly in CSV
2. Export specific sheets

I've attached a file from my FTP:

http://www.jyxsaw.com/ZCOU/ACNOVdem.xlsx

I just want to export the double quoted values in Sheets p1 & p2

I've found the following macros on other sites but are to no avail:

1. This one just doesn't seem to work and does not allow me to specify the sheet that I'm trying to dump

Code:

Sub CSVFile()
Dim SrcRg As Range
Dim CurrRow As Range
Dim CurrCell As Range
Dim CurrTextStr As String
Dim ListSep As String
Dim FName As Variant
FName = Application.GetSaveAsFilename("", "CSV File (*.csv), *.csv")
ListSep = Application.International(xlListSeparator)
  If Selection.Cells.Count > 1 Then
    Set SrcRg = Selection
  Else
    Set SrcRg = ActiveSheet.UsedRange
  End If
Open FName For Output As #1
For Each CurrRow In SrcRg.Rows
  CurrTextStr = ìî
For Each CurrCell In CurrRow.Cells
  CurrTextStr = CurrTextStr & """" & CurrCell.Value & """" & ListSep
Next
While Right(CurrTextStr, 1) = ListSep
  CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1)
Wend
Print #1, CurrTextStr
Next
Close #1
End Sub

This one does work but does not allow me to select muliple sheets

Code:

Sub CSVFile()
Dim SrcRg As Range
Dim CurrRow As Range
Dim CurrCell As Range
Dim CurrTextStr As String
Dim ListSep As String
Dim FName As Variant
FName = Application.GetSaveAsFilename("", "CSV File (*.csv), *.csv")
ListSep = Application.International(xlListSeparator)
  If Selection.Cells.Count > 1 Then
    Set SrcRg = Selection
  Else
    Set SrcRg = ActiveSheet.UsedRange
  End If
Open FName For Output As #1
For Each CurrRow In SrcRg.Rows
  CurrTextStr = ìî
For Each CurrCell In CurrRow.Cells
  CurrTextStr = CurrTextStr & """" & CurrCell.Value & """" & ListSep
Next
While Right(CurrTextStr, 1) = ListSep
  CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1)
Wend
Print #1, CurrTextStr
Next
Close #1
End Sub

Ideas? Thanks for the help guys

tlowry · Nov 12, 2011

You might look at..

Open sfile For Output As #ifile
<… build output line >
Print #ifile, sLineOut

I think this leaves everything as is. You must put in the commas as well.

see:

http://www.mrexcel.com/forum/showthread.php?t=590018&highlight=#ifile

for some code

xenou · Nov 12, 2011

This one does work but does not allow me to select muliple sheets

Editing the working code to use more than one worksheet, and to specify the name(s) of the sheets:

Code:

Sub CSVFile()
Dim SrcRg As Range
Dim CurrRow As Range
Dim CurrCell As Range
Dim CurrTextStr As String
Dim ListSep As String
Dim FName As Variant
Dim arrWorksheets As Variant
Dim i As Long
    
    On Error GoTo ErrHandler:
    ListSep = Application.International(xlListSeparator)
    arrWorksheets = Array("p1", "Sheet2", "Sheet3")
    
    
    FName = Application.GetSaveAsFilename("", "CSV File (*.csv), *.csv")
    If FName = False Then
        Exit Sub
    Else
        Open FName For Output As #1
    End If
    
    For i = 0 To UBound(arrWorksheets)
        With Worksheets(arrWorksheets(i))
            If WorksheetFunction.CountA(.Cells) > 0 Then
                Set SrcRg = .UsedRange
                For Each CurrRow In SrcRg.Rows
                    CurrTextStr = ""
                    For Each CurrCell In CurrRow.Cells
                        CurrTextStr = CurrTextStr & """" & CurrCell.Value & """" & ListSep
                    Next
                    While Right(CurrTextStr, 1) = ListSep
                        CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1)
                    Wend
                    Print #1, CurrTextStr
                Next
            End If
        End With
    Next i
    Close #1

My_Exit:
On Error Resume Next
Close #1
Exit Sub

ErrHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume My_Exit

End Sub

one difference is that the original code you posted let you select cells to write to CSV, whereas this will just write out what's in the "UsedRange" for each of the sheets - beware that UsedRanges can sometime include blank rows.

xenou · Nov 12, 2011

For what it's worth, just straight saving an Excel worksheet as a .prn file seems to be able to write your quoted cells okay, but there's no comma delimiter so it only works if you have one column of data to save.

Export Double Quotes CSV from Specific Sheet

somebody113

New Member

tlowry

Well-known Member

xenou

MrExcel MVP

xenou

MrExcel MVP

Similar threads

Share this page

Export Double Quotes CSV from Specific Sheet

somebody113

New Member

tlowry

Well-known Member

xenou

MrExcel MVP

xenou

MrExcel MVP

Similar threads

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock