XLA routines: EE_ExportRangeToCSV

Nick's picture
EE_ExportRangeToCSV creates a csv file from a range of data, and replaces errors.
Function EE_ExportRangeToCSV(strCSVfileName As String, rngExport As range, Optional blnDispMsg As Boolean = False) As Boolean
'-Takes a csv file name
'-deletes existing
'- converts all dates or times to longs - not implemented
'- exports CSV
' - if the cell contains an error (eg: #Value), it writes 'ERROR'
'- restores date time formatting - not implemented
'- returns True if success
    Dim wbkCSV              As Workbook
    Dim strCSVfullFilePath  As String
 
'http://excelexperts.com/xla-routines-eeExportRangeToCSV    for updates on this function

    If InStr(strCSVfileName, Application.PathSeparator) > 0 Then
        strCSVfullFilePath = Replace(strCSVfileName, ".csv", "") & ".csv"
    Else
        strCSVfullFilePath = ThisWorkbook.Path & Application.PathSeparator & Replace(strCSVfileName, ".csv", "") & ".csv"
    End If
 
    With CreateObject("Scripting.FileSystemObject")
        If .FileExists(strCSVfileName) Then
            On Error Resume Next
                .deletefile strCSVfullFilePath
                If Err.Number <> 0 Then
                    EE_ExportRangeToCSV = False
                    If blnDispMsg = True Then
                        MsgBox Err.Description, vbCritical, "File locked"
                    End If
                    Exit Function
                End If
            On Error GoTo 0
        End If
    End With
 
    Set wbkCSV = Application.Workbooks.Add(1)
 
    rngExport.Copy
    wbkCSV.Worksheets(1).range("A1").PasteSpecial xlPasteAll
    Application.CutCopyMode = False
 
    On Error Resume Next
        With wbkCSV.Worksheets(1).UsedRange
            .SpecialCells(xlCellTypeConstants, 16).value = "ERROR"
            .SpecialCells(xlCellTypeFormulas, 16).value = "ERROR"
        End With
    On Error GoTo 0
 
    Application.DisplayAlerts = False
 
    On Error GoTo ErrH
        wbkCSV.SaveAs strCSVfullFilePath, xlCSV
    On Error GoTo 0: Err.Clear
 
    EE_ExportRangeToCSV = True
    GoTo ExitH
ErrH:
    EE_ExportRangeToCSV = False
ExitH:
    wbkCSV.Close False
    Application.DisplayAlerts = True
    Set wbkCSV = Nothing
End Function