VBA Macro to Export Data from Excel Spreadsheet to CSV

[tzcoding]

Situation:
Here is what i have working now. The VBA code will save a copy of the current sheet as an archive file in .CSV format. I'm able to assigned it to a button and it will do it on a sheet by sheet basses. This means what ever sheet the button is assigned to it will export that sheet and label it accordingly.

Help Needed:
I need help altering the code so that i can also select the file path or provide it a file path directly so i don't have to do it manually.

Sub Export_CSV()

    '***************************************************************************************
    'purpose:   export current spreadsheet to csv.file to the same file path as source file
    '
    ' !!NOTE!!  files with same name and path will be overwritten
    '***************************************************************************************
 
    Dim MyPath As String
    Dim MyFileName As String
    Dim WB1 As Workbook, WB2 As Workbook
    
    Set WB1 = ActiveWorkbook

    '(1) either used range in active sheet..
    'ActiveWorkbook.ActiveSheet.UsedRange.Copy
    
    '(2) or alternatively, user selected input range:
    Dim rng As Range
    Set rng = Application.InputBox("select cell range with changes", "Cells to be copied", Default:="Select Cell Range", Type:=8)
    Application.ScreenUpdating = False
    rng.Copy

    Set WB2 = Application.Workbooks.Add(1)
    WB2.Sheets(1).Range("A1").PasteSpecial xlPasteValues
    
    MyFileName = "CSV_Export_" & Format(Date, "ddmmyyyy")
    FullPath = WB1.Path & "\" & MyFileName
    
    Application.DisplayAlerts = False
    If MsgBox("Data copied to " & WB1.Path & "\" & MyFileName & vbCrLf & _
    "Warning: Files in directory with same name will be overwritten!!", vbQuestion + vbYesNo) <> vbYes Then
        Exit Sub
    End If
    
    If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"
    With WB2
        .SaveAs Filename:=FullPath, FileFormat:=xlCSV, CreateBackup:=False
        .Close False
    End With
    Application.DisplayAlerts = True
End Sub

 

[Domenic]

I have amended your code so that it uses the FileDialog object to prompt the user to select a folder. Also, I noticed that you'll get an error when the user cancels Application.InputBox, so I have added an error handler as well.

Sub Export_CSV()

    '***************************************************************************************
    'purpose:   export current spreadsheet to csv.file to the same file path as source file
    '
    ' !!NOTE!!  files with same name and path will be overwritten
    '***************************************************************************************
 
    Dim MyPath As String
    Dim MyFileName As String
    Dim FullPath As String
    Dim WB1 As Workbook, WB2 As Workbook
   
    With Application.FileDialog(msoFileDialogFolderPicker)
        .ButtonName = "Select"
        .InitialFileName = Application.DefaultFilePath & "\" 'change the default file path as desired
        .Title = "Please select a folder for export"
        If .Show = 0 Then Exit Sub
        MyPath = .SelectedItems(1)
    End With
   
    Set WB1 = ActiveWorkbook

    '(1) either used range in active sheet..
    'ActiveWorkbook.ActiveSheet.UsedRange.Copy
   
    '(2) or alternatively, user selected input range:
    Dim rng As Range
    On Error Resume Next
    Set rng = Application.InputBox("select cell range with changes", "Cells to be copied", Default:="Select Cell Range", Type:=8)
    If rng Is Nothing Then Exit Sub
    On Error GoTo 0
    Application.ScreenUpdating = False
    rng.Copy

    Set WB2 = Application.Workbooks.Add(1)
    WB2.Sheets(1).Range("A1").PasteSpecial xlPasteValues
   
    MyFileName = "CSV_Export_" & Format(Date, "ddmmyyyy")
    FullPath = MyPath & "\" & MyFileName
   
    Application.DisplayAlerts = False
    If MsgBox("Data copied to " & MyPath & "\" & MyFileName & vbCrLf & _
    "Warning: Files in directory with same name will be overwritten!!", vbQuestion + vbYesNo) <> vbYes Then
        Exit Sub
    End If
   
    If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"
    With WB2
        .SaveAs Filename:=FullPath, FileFormat:=xlCSV, CreateBackup:=False
        .Close False
    End With
    Application.DisplayAlerts = True
End Sub

Hope this helps!