aye cee
aye cee

Reputation: 193

VBA Saving CSV (comma delimited)

I can Save worksheets manually as CSV (Comma delimited) with UTF-8 Encoding, without any errors. However when I use the below code to do it, the resulting CSV has a #NAME? error in 2 of the cells.

In these 2 cells is a formula for a User Defined "TEXT JOIN" function. I could post that (long) code here, but given that when I save manually the cells in question display correctly I figure there is something missing in my code that makes it differ from a manual save.

Sub SheetsToCSV()
    Dim xWs As Worksheet
    Dim xcsvFile As String
    Dim SaveToDirectory As String
    SaveToDirectory = "Z:\CSV\"
    For Each xWs In Application.ActiveWorkbook.Worksheets
        If xWs.Name <> "Sheet1" Then
            xWs.Copy
            xcsvFile = SaveToDirectory & "\" & xWs.Name & ".csv"
            Application.ActiveWorkbook.SaveAs Filename:=xcsvFile, _
            FileFormat:=xlCSV, CreateBackup:=False
            Application.ActiveWorkbook.Saved = True
            Application.ActiveWorkbook.Close
        End If
    Next
End Sub

What could the issue be?

Upvotes: 0

Views: 4050

Answers (1)

FaneDuru
FaneDuru

Reputation: 42236

Please, test the next code. In order to avoid the missing UDF issue, in the intermediary workbook to be saved, it uses a helper workbook where only the values are pasted:

Sub SheetsToCSVNew()
    Dim xWs As Worksheet, xcsvFile As String, wbAct As Workbook, wbHelp As Workbook
    Dim wsH As Worksheet, SaveToDirectory As String, arrCopy
    
    Set wbAct = ActiveWorkbook  'set the active workbook
    Set wbHelp = Workbooks.Add(xlWBATWorksheet) 'add a new workbook
    Set wsH = wbHelp.Sheets(1)  'set the new workbook first sheet
    
    SaveToDirectory = "Z:\CSV\"
    For Each xWs In wbAct.Worksheets
        If xWs.Name <> "Sheet1" Then
            arrCopy = xWs.UsedRange.Value 'put the sheet content in an array
            With wsH
                .Cells.ClearContents      'clear the helper sheet before a new pasting - saving as step
                .Range("A1").Resize(UBound(arrCopy), UBound(arrCopy, 2)).Value = arrCopy                       'drop the array content at once
                .UsedRange.EntireColumn.AutoFit 'Fit the columns in the pasted sheet
            End With
            xcsvFile = SaveToDirectory & xWs.Name & ".csv"
            wbHelp.SaveAs Filename:=xcsvFile, FileFormat:=xlCSV
        End If
    Next
    wbHelp.Close False 'close the helper workbook
End Sub

Upvotes: 1

Related Questions