VBA to bulk Convert xls to xlsx (from specific folder to specific folder)-CodePudding

am new to VBA, need some expert assistance/advice.

I have some files which are saved in xls format, auto generated from the system (daily) but I need them to be in xlsx format before I can use it on power bi.

I found a great code online to do the conversion but the main issue is I need to manually select the source & destination folders.

Just would like to ask if it's possible to specify the folders instead.

Have tried the code from online and it worked great. Only issue is need to trigger it manually by selecting the source and destination folders.

Am looking to achieve automation in conjunction with power automate to trigger the VBA code for conversion. To achieve this, I need to do away with the manual selection of source and destination folders.

Sub ConvertToXlsx()

Dim strPath As String
Dim strFile As String
Dim xWbk As Workbook
Dim xSFD, xRFD As FileDialog
Dim xSPath As String
Dim xRPath As String
Set xSFD = Application.FileDialog(msoFileDialogFolderPicker)
With xSFD
.Title = "Please select the folder contains the xls files:"
.InitialFileName = "C:\"
End With
If xSFD.Show <> -1 Then Exit Sub
xSPath = xSFD.SelectedItems.Item(1)
Set xRFD = Application.FileDialog(msoFileDialogFolderPicker)
With xRFD
.Title = "Please select a folder for outputting the new files:"
.InitialFileName = "C:\"
End With
If xRFD.Show <> -1 Then Exit Sub
xRPath = xRFD.SelectedItems.Item(1) & "\"
strPath = xSPath & "\"
strFile = Dir(strPath & "*.xls")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Do While strFile <> ""
If Right(strFile, 3) = "xls" Then
Set xWbk = Workbooks.Open(Filename:=strPath & strFile)
xWbk.SaveAs Filename:=xRPath & strFile & "x", _
FileFormat:=xlOpenXMLWorkbook
xWbk.Close SaveChanges:=False
End If
strFile = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

CodePudding user response：

Please, use the next adapted code:

Sub ConvertToXlsx()
Dim strPath As String, strFile As String
Dim xWbk As Workbook, xSPath As String, xRPath As String

xSPath = "C:\your real folder path for xls files"

xRPath = "C:\ your destination folder"

strPath = xSPath & "\"
strFile = Dir(strPath & "*.xls")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Do While strFile <> ""
    'If Right(strFile, 3) = "xls" Then 'no need for it since Dir returns ONLY xls files...
        Set xWbk = Workbooks.Open(fileName:=strPath & strFile)
        xWbk.saveas fileName:=xRPath & strFile & "x", _
                           FileFormat:=xlWorkbookDefault
             'FileFormat:=xlOpenXMLWorkbook 'the above format is more suitable for a xlsx type...
        xWbk.Close SaveChanges:=False
    'End If
    strFile = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub