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

muhammad susanto

Well-known Member
Joined
Jan 8, 2013
Messages
2,077
Office Version
  1. 365
  2. 2021
Platform
  1. Windows
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:

VBA 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
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Check if the following is what you need:

VBA Code:
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
 
Upvote 0
Solution
Check if the following is what you need:

VBA Code:
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.
 
Upvote 0
Im glad to help you. Thanks for the feedback
 
Upvote 0

Forum statistics

Threads
1,218,559
Messages
6,143,198
Members
450,469
Latest member
brent3162

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top