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"
        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)
    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
    EE_ExportRangeToCSV = False
    wbkCSV.Close False
    Application.DisplayAlerts = True
    Set wbkCSV = Nothing
End Function