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

Question

I have a process that I run on sets of workbooks. I'm trying to modify the filetype when I close the file. I'm trying to tack it onto the end of the process before closing each workbook. Right now, the opened file is in .xlsb. I'm trying to save it in basically any other format (.xsls, etc.)

Whenever I run the Macro the "SaveAs" command errors out. I've tried everything I can think of to have it just save the file with the same name, different filetype, but no luck.

What am I doing wrong?

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

Backup Workbooks

• Use variables to avoid (long) unreadable lines (parameters).

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