如何指定源文件夹和目标文件夹（在 xls 到 xlsx 的批量转换中）？答案

【问题标题】：How to specify source and destination folders (in a bulk conversion of xls to xlsx)?如何指定源文件夹和目标文件夹（在 xls 到 xlsx 的批量转换中）？
【发布时间】：2022-12-03 16:19:05
【问题描述】：

我有以 xls 格式保存的文件，由系统自动生成（每天）。在我可以在 power bi 上使用它们之前，我需要它们的 xlsx 格式。

我在网上找到了进行转换的代码，但我需要手动选择源文件夹和目标文件夹。

是否可以指定文件夹？

我希望与电源自动化一起实现自动化以触发 VBA 代码进行转换。为此，我需要取消手动选择源文件夹和目标文件夹。

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

【问题讨论】：

你能显示代码吗？你尝试过什么吗？
您好，这是我找到并尝试过的代码。它太长了，所以我必须将代码分成 2 条消息。 ---------------------------------- 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 = "请选择包含 xls 文件的文件夹：" .InitialFileName = "C:\" End With
“我需要手动选择源文件夹和目标文件夹”是什么意思？代码是否打开对话框以选择讨论中的文件夹？这样的代码应该很短。为什么说这么长？但编辑您的问题并将其放在那里，不在评论中！
如果 xSFD.Show <> -1 Then Exit Sub xSPath = xSFD.SelectedItems.Item(1) Set xRFD = Application.FileDialog(msoFileDialogFolderPicker) With xRFD .Title = "Please select a folder for output 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
设置 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

标签： excel vba

【解决方案1】：

请使用下一个改编代码：

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

【讨论】：