宏 VBA，无法使 "SaveAs" 运行

Question

我有一个运行工作簿集的过程。我试图在关闭文件时修改文件类型。在关闭每个工作簿之前，我试图将其添加到流程的末尾。现在，打开的文件是 .xlsb。我正在尝试将其保存为基本上任何其他格式（.xsls 等）

每当我运行宏时，“另存为”命令就会出错。我已经尝试了所有我能想到的方法，只是用相同的名称、不同的文件类型保存文件，但没有成功。

我做错了什么？



Application.ScreenUpdating = False
Application.DisplayAlerts = False

Path = ThisWorkbook.Sheets(1).Range("H6")

If Right(Path, 1) <> "\" Then
    Path = Path & "\"
End If


wsheet = ThisWorkbook.Sheets(1).Range("F10")

ThisWorkbook.Sheets(3).Range("A2:B20000").ClearContents
OutLn = 2
Line = 1

Do While ThisWorkbook.Sheets(2).Cells(Line, 1) <> ""
    OpnFil = ThisWorkbook.Sheets(2).Cells(Line, 1)
    Workbooks.Open fileName:=Path & OpnFil, UpdateLinks:=False
    ScanLn = 12
        Do While ThisWorkbook.Sheets(1).Cells(ScanLn, 5) <> ""
            ThisWorkbook.Sheets(3).Cells(OutLn, 1) = OpnFil
            Addr = ThisWorkbook.Sheets(1).Cells(ScanLn, 5)
            ThisWorkbook.Sheets(3).Cells(OutLn, 2) = Workbooks(OpnFil).Sheets(wsheet).Range(Addr)
            OutLn = OutLn + 1
            ScanLn = ScanLn + 1
        Loop
    Workbooks(OpnFil).SaveAs fileName:=Workbooks(OpnFil).GetBaseName, FileFormat:=51
    Workbooks(OpnFil).Close
    Line = Line + 1
Loop

End Sub```

Answer 1

备份工作簿

使用变量来避免（长）不可读的行（参数）。

Option Explicit

Sub BackupWorkbooks()
    
    Dim swb As Workbook: Set swb = ThisWorkbook
    
    Dim dFolderPath As String: dFolderPath = swb.Sheets(1).Range("H6").Value
    If Right(dFolderPath, 1) <> "\" Then
        dFolderPath = dFolderPath & "\"
    End If
    
    Dim dwsName As String: dwsName = swb.Sheets(1).Range("F10").Value
    
    Application.ScreenUpdating = False
    
    swb.Sheets(3).Range("A2:B" & swb.Sheets(3).Rows.Count).ClearContents
    
    Dim OutLn As Long: OutLn = 2
    Dim Line As Long: Line = 1
    
    Dim dwb As Workbook
    Dim dOldName As String
    Dim dOldPath As String
    Dim dNewPath As String
    Dim dAddr As String
    Dim ScanLn As Long
    
    Do While swb.Sheets(2).Cells(Line, 1) <> ""
        
        dOldName = swb.Sheets(2).Cells(Line, 1)
        dOldPath = dFolderPath & dOldName
        Set dwb = Workbooks.Open(Filename:=dOldPath, UpdateLinks:=False)
        
        ScanLn = 12
        Do While swb.Sheets(1).Cells(ScanLn, 5).Value <> ""
            swb.Sheets(3).Cells(OutLn, 1).Value = dOldName
            dAddr = swb.Sheets(1).Cells(ScanLn, 5).Value
            swb.Sheets(3).Cells(OutLn, 2).Value _
                = dwb.Worksheets(dwsName).Range(dAddr).Value
            OutLn = OutLn + 1
            ScanLn = ScanLn + 1
        Loop
        
        dNewPath = Left(dOldPath, InStrRev(dOldPath, ".") - 1) & ".xlsx"
        ' Or if you insist:
        'dNewPath =  dFolderPath & CreateObject("Scripting.FileSystemObject") _
            .GetBaseName(dOldName) & ".xlsx"
        
        Application.DisplayAlerts = False
        dwb.SaveAs Filename:=dNewPath, FileFormat:=xlOpenXMLWorkbook ' 51
        Application.DisplayAlerts = True
        dwb.Close
        
        Line = Line + 1
    
    Loop

    Application.ScreenUpdating = True
    
    MsgBox "Backups created.", vbInformation, "Backup Workbooks"

End Sub

宏 VBA，无法使 "SaveAs" 运行

Macro VBA, can't get "SaveAs" to function

excel

vba

save-as

备份工作簿