VBA : Convert CSV To XLSX Can't Save Into Different Folder

[muhammad susanto]

hi all...

the macro code actually work fine, but i want to macro work fine in condition like this:
first time, when i open csv file, then running code show/browse locate folder where the "new file (in xlsx format)" can be place to save.
this code can't work for it, and the code always "looking for" where csv file in there (always in same location folder). It's not simple for me..
this my expected result step by step like this:
1. Open CSV file, then copy/running macro code then browse location folder where the new file (in xlsx format) can saved.
the core, the new file (in xlsx format) after converted can be saved in new folder/different folder.
here this code:

Sub CSVtoXLS()
    'UpdatebyExtendoffice20170814
    Dim xFd         As FileDialog
    Dim xSPath      As String
    Dim xCSVFile    As String
    Dim xWsheet     As String
    Dim wkbActv     As Workbook
    Dim wkbCSV      As Workbook

    Application.DisplayAlerts = False
    Application.StatusBar = True

    Set wkbActv = ActiveWorkbook

    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    xFd.Title = "Select a folder:"

    If xFd.Show = -1 Then
        xSPath = xFd.SelectedItems(1)
    Else
        Exit Sub
    End If

    If Right(xSPath, 1) <> "\" Then xSPath = xSPath & "\"
    xCSVFile = Dir(xSPath & "*.csv")

    Do While xCSVFile <> ""
        Application.StatusBar = "Converting: " & xCSVFile
        
        Set wkbCSV = Workbooks.Open(Filename:=xSPath & xCSVFile)
        
        wkbCSV.SaveAs Replace(xSPath & xCSVFile, ".csv", ".xlsx", vbTextCompare), xlWorkbookDefault
        wkbCSV.Close
        
        xCSVFile = Dir
    Loop

    wkbActv.Activate

    Application.StatusBar = False
    Application.DisplayAlerts = True
End Sub

someone help me, thank you so much.

m.susanto

 

[DanteAmor]

Check if the following is what you need:

Sub CSVtoXLS()
  'UpdatebyExtendoffice20170814
  Dim xSPath    As String, NewPath    As String
  Dim xCSVFile  As String
  Dim wkbActv   As Workbook, wkbCSV   As Workbook
  
  Set wkbActv = ActiveWorkbook
  With Application
    .DisplayAlerts = False
    .StatusBar = True
    .ScreenUpdating = False
    
    With .FileDialog(msoFileDialogFolderPicker)
      .Title = "Select the folder where the csv's are"
      If .Show <> -1 Then Exit Sub
      xSPath = .SelectedItems(1) & "\"
    
      .Title = "Select the folder where you want the new xlsx"
      If .Show <> -1 Then Exit Sub
      NewPath = .SelectedItems(1) & "\"
    End With
  End With
  
  xCSVFile = Dir(xSPath & "*.csv")
  Do While xCSVFile <> ""
    Application.StatusBar = "Converting: " & xCSVFile
    Set wkbCSV = Workbooks.Open(Filename:=xSPath & xCSVFile)
    wkbCSV.SaveAs Replace(NewPath & xCSVFile, ".csv", ".xlsx", vbTextCompare), xlWorkbookDefault
    wkbCSV.Close
    xCSVFile = Dir
  Loop
  
  wkbActv.Activate
  Application.StatusBar = False
  Application.DisplayAlerts = True
End Sub

 

[muhammad susanto]

Check if the following is what you need:

Sub CSVtoXLS()
  'UpdatebyExtendoffice20170814
  Dim xSPath    As String, NewPath    As String
  Dim xCSVFile  As String
  Dim wkbActv   As Workbook, wkbCSV   As Workbook
 
  Set wkbActv = ActiveWorkbook
  With Application
    .DisplayAlerts = False
    .StatusBar = True
    .ScreenUpdating = False
   
    With .FileDialog(msoFileDialogFolderPicker)
      .Title = "Select the folder where the csv's are"
      If .Show <> -1 Then Exit Sub
      xSPath = .SelectedItems(1) & "\"
   
      .Title = "Select the folder where you want the new xlsx"
      If .Show <> -1 Then Exit Sub
      NewPath = .SelectedItems(1) & "\"
    End With
  End With
 
  xCSVFile = Dir(xSPath & "*.csv")
  Do While xCSVFile <> ""
    Application.StatusBar = "Converting: " & xCSVFile
    Set wkbCSV = Workbooks.Open(Filename:=xSPath & xCSVFile)
    wkbCSV.SaveAs Replace(NewPath & xCSVFile, ".csv", ".xlsx", vbTextCompare), xlWorkbookDefault
    wkbCSV.Close
    xCSVFile = Dir
  Loop
 
  wkbActv.Activate
  Application.StatusBar = False
  Application.DisplayAlerts = True
End Sub

hi DanteAmor, thank you so much.

 

[DanteAmor]

Im glad to help you. Thanks for the feedback