VBA-export sheets to .csv without double quotes...

[RobbieC]

Hi there, I have been using this script successfully to export data from a sheet to csv (.txt):

Sub CSVExport()


    Dim var1 As String
    Dim var2 As String
    Dim var3 As String
    Dim var4 As String
    
    'Find the last row that contains data
    With Worksheets("Sheet1")
        lLastRow = .Cells(.Rows.Count, "A").End(xlUp).row
    End With
    
    'Setting the name and the path of text file based on workbook path
    sFName = ThisWorkbook.Path & "csvoutput.txt"
        
    'Get an unused file number
    intFNumber = FreeFile
    
    'Create a new file (or overwrite an existing one)
    Open sFName For Output As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=intFNumber]#intFNumber[/URL] 
        
    For lCounter = 1 To lLastRow


     'Read specific data from the worksheet
        With Worksheets("Sheet1")
            var1 = .Cells(lCounter, 1)
            var2 = .Cells(lCounter, 2)
            var3 = .Cells(lCounter, 3)
            var4 = .Cells(lCounter, 4)
        End With
        
        'Write selected data to text file
        Write [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=intFNumber]#intFNumber[/URL] , var1, var2, var3, var4
        
    'Continue looping until the last row
    Next lCounter
    
    'Close the text file
    Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=intFNumber]#intFNumber[/URL] 
   
End Sub

However, this script inserts double quotes around each "item" - I need to export the file without double quotes... Is there any way to adapt my above script to do this or will I have to look for a new solution?

If you can point me in the right direction, I'd be most grateful

Thanks

 

[Domenic]

Since you're assigning values to var1, var2, var3, and var4 using the Values property of the Range object, not the Text property, you can use the Print statement instead...

Print #intFNumber , var1 & "," & var2 & "," & var3 & "," & var4

Hope this helps!

 

[RobbieC]

Domenic, you are a star! Thanks very much mate

 

[sameer7089]

getting compile error
syntex error

please help

 

[RobbieC]

What have you got in your code sameer?

 

[sameer7089]

Its the

What have you got in your code sameer?

Its the same code I am trying to run in my excel but giving attached error. I need to double quote to all my data in excels including dates also.
I tried with \"@\" .. it worked but changed entire format of excels.. dates changed into m=numbers.

 

[RobbieC]

Try this:

Sub CSVExport()


On Error Resume Next


Application.ScreenUpdating = False


SheetName = ActiveSheet.Name
Sheets("Sheet1").Activate 'replace with correct sheet


    Dim field1 As String
    Dim field2 As String
    Dim field3 As String
    Dim field4 As String
    
    Dim sFName As String
    Dim intFNumber As Integer
    Dim lCounter As Long
    Dim lLastRow As Long
    
    With Worksheets("Sheet1") 'replace with correct sheet
        lLastRow = .Cells(.Rows.count, "A").End(xlUp).Row
    End With
    
    sFName = ThisWorkbook.Path & "csvoutput.txt"
    intFNumber = FreeFile
    Open sFName For Output As #intFNumber
        
    For lCounter = 1 To lLastRow
        With Worksheets("Sheet1") 'replace with correct sheet
            field1 = .Cells(lCounter, 1)
            field2 = .Cells(lCounter, 2)
            field3 = .Cells(lCounter, 3)
            field4 = .Cells(lCounter, 4)
        End With
        Write #intFNumber, field1, field2, field3, field4
    Next lCounter
    Close #intFNumber


    Sheets(SheetName).Activate


    Application.ScreenUpdating = True
  
End Sub

 

[sameer7089]

Try this:

Sub CSVExport()


On Error Resume Next


Application.ScreenUpdating = False


SheetName = ActiveSheet.Name
Sheets("Sheet1").Activate 'replace with correct sheet


    Dim field1 As String
    Dim field2 As String
    Dim field3 As String
    Dim field4 As String
   
    Dim sFName As String
    Dim intFNumber As Integer
    Dim lCounter As Long
    Dim lLastRow As Long
   
    With Worksheets("Sheet1") 'replace with correct sheet
        lLastRow = .Cells(.Rows.count, "A").End(xlUp).Row
    End With
   
    sFName = ThisWorkbook.Path & "csvoutput.txt"
    intFNumber = FreeFile
    Open sFName For Output As #intFNumber
       
    For lCounter = 1 To lLastRow
        With Worksheets("Sheet1") 'replace with correct sheet
            field1 = .Cells(lCounter, 1)
            field2 = .Cells(lCounter, 2)
            field3 = .Cells(lCounter, 3)
            field4 = .Cells(lCounter, 4)
        End With
        Write #intFNumber, field1, field2, field3, field4
    Next lCounter
    Close #intFNumber


    Sheets(SheetName).Activate


    Application.ScreenUpdating = True
 
End Sub

Hi, Thanks for the code. Its running without error but not able to fetch csv or excel with double quotes

 

[RobbieC]

that code *should* write a file 'csvoutput.txt' into the same folder as your Excel file...

 

[RobbieC]

Ah, there was a missing '\' in the output line... try this:

Sub CSVExport()


On Error Resume Next


Application.ScreenUpdating = False


SheetName = ActiveSheet.Name
Sheets("Sheet1").Activate
'Sheets("ImportExport").Range("A1:E100").Select
'Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete


    Dim field1 As String
    Dim field2 As String
    Dim field3 As String
    Dim field4 As String
    
    Dim sFName As String
    Dim intFNumber As Integer
    Dim lCounter As Long
    Dim lLastRow As Long
    
    With Worksheets("Sheet1")
        lLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
    
    sFName = ThisWorkbook.Path & "\csvOutput.txt"
    intFNumber = FreeFile
    Open sFName For Output As #intFNumber
        
    For lCounter = 1 To lLastRow
        With Worksheets("Sheet1")
            field1 = .Cells(lCounter, 1)
            field2 = .Cells(lCounter, 2)
            field3 = .Cells(lCounter, 3)
            field4 = .Cells(lCounter, 4)
        End With
        Write #intFNumber, field1, field2, field3, field4
    Next lCounter
    Close #intFNumber
    
    'Sheets("Sheet1").Cells.Clear


    Sheets(SheetName).Activate


    Application.ScreenUpdating = True
  
End Sub