将多个 xlsx 文件转换为 xls (97-2003 Worksheet) 扩展名而不更改名称

Question

我正在尝试遍历文件夹中的所有“xlsx”文件并将它们转换为“xls”（Excel 97-2003 工作表）格式。我使用以下代码，但输出文件仍保存为“xlsx”而不是“xls”。我是初学者，希望向他人学习更多。感谢您的帮助！

Sub Convert()

Dim strPath As String
Dim strFile As String
Dim strfilenew 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 & "*.xlsx")
strfilenew = Dir(strPath & "*.xls")

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Do While strFile <> ""

If Right(strFile, 4) = "xlsx" Then
Set xWbk = Workbooks.Open(Filename:=strPath & strfilenew)
xWbk.SaveAs Filename:=xRPath & strfilenew, _
FileFormat:=xlExcel18
xWbk.Close SaveChanges:=True
End If

strFile = Dir
Loop

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Answer 1

您的文件命名有些混乱，我删除的几个双重声明基本上证明了这一点。真正的大错误在这里，Set xWbk = Workbooks.Open(Filename:=strPath & strfilenew) 你试图用新名称打开旧工作簿。我认为混乱始于"Please select the folder contains the xls files:"。当然，这是包含 XLSX 文件的文件夹。推荐的解药是使用“有意义的”变量名，但您选择用谜语说话（如xSFD），这使得编码更加困难。

但是，下面的代码大部分是你的，它确实有效。

Sub Convert()
    ' 230

    Dim Spath           As String               ' path to read from (XLSX files)
    Dim Rpath           As String               ' path to write to (XLS files)
    Dim strFile         As String               ' loop variable: current file name
    Dim Wbk             As Workbook             ' loop object: current workbook(strFile)
    Dim Sp()            As String               ' split array of strFile
    Dim strFileNew      As String
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Please select the folder contains the XLSX files:"
        .InitialFileName = "C:\"
        If .Show <> -1 Then Exit Sub
        Spath = .SelectedItems.Item(1) & "\"
    End With
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Please select a folder for outputting the new files:"
        .InitialFileName = "C:\"
        If .Show <> -1 Then Exit Sub
        Rpath = .SelectedItems.Item(1) & "\"
    End With
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    
    strFile = Dir(Spath & "*.xlsx")
    Do While strFile <> ""
        If Right(strFile, 4) = "xlsx" Then
            Sp = Split(strFile, ".")
            Sp(UBound(Sp)) = "xls"
            strFileNew = Join(Sp, ".")
            Set Wbk = Workbooks.Open(Filename:=Spath & strFile)
            Wbk.SaveAs Filename:=Rpath & strFileNew, FileFormat:=xlExcel8
            Wbk.Close SaveChanges:=True
        End If
        strFile = Dir
    Loop

    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
End Sub

观察新文件名是通过在句点上拆分旧名称、更改最后一个元素并重新组装修改后的数组来创建的。