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

muhammad susanto

Well-known Member
Joined
Jan 8, 2013
Messages
1,959
Office Version
  1. 2013
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

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
14,769
Office Version
  1. 2010
Platform
  1. Windows
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
 
Solution

muhammad susanto

Well-known Member
Joined
Jan 8, 2013
Messages
1,959
Office Version
  1. 2013
Platform
  1. Windows
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.
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
14,769
Office Version
  1. 2010
Platform
  1. Windows
Im glad to help you. Thanks for the feedback
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,163,602
Messages
5,832,665
Members
430,153
Latest member
Javid_P

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
Top