2

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```
braX
  • 11,506
  • 5
  • 20
  • 33
tdave22
  • 23
  • 3
  • 1
    A `Workbook` doesn't have a `GetBaseName` method. [`GetBaseName`](https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/getbasename-method) is a method of a `FileSystemObject`. – BigBen Jun 29 '21 at 19:39
  • No, maybe that's my issue. I was hoping it would just save to the same extension it opened from (Path) with the same filename. – tdave22 Jun 29 '21 at 19:52
  • I've also tried this ```Workbooks(OpnFil).SaveAs fileName:=Workbooks(OpnFil).Name, FileFormat:=51``` and about a hundred others lol. – tdave22 Jun 29 '21 at 20:00
  • 1
    Keep in mind that `FileFormat` has to match the extension or you will get an error. – braX Jun 29 '21 at 20:02
  • OK, that's good to know, the file being opened is an .xlsb. Part of what I'm trying to add is to save it down as another filepath .xls/.xlsx. I thought I could do so by adding that ```FileFormat``` value. – tdave22 Jun 29 '21 at 20:12
  • Specify the extension you want then, and make sure it matches the `FileFormat`. If the filename doesn't have an extension, it's not going to work. – braX Jun 29 '21 at 20:41
  • So how do I specify a different file extension than it already has? By using ```Workbooks(OpnFil).Name```, I'm already including the ".xlsb" in the ```SaveAs``` filename, right? – tdave22 Jun 29 '21 at 21:42
  • https://stackoverflow.com/a/27924854/9245853 – BigBen Jun 29 '21 at 22:56
  • @BigBen, that thread is where I got the idea to use the ```GetBaseName``` method, but it keeps erroring out. I'll check to see if I missed something. – tdave22 Jun 29 '21 at 23:18
  • You missed the `Dim fso As New Scripting.FileSystemObject`, and calling `fso.GetBaseName(...)`. – BigBen Jun 29 '21 at 23:21

1 Answers1

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
VBasic2008
  • 44,888
  • 5
  • 17
  • 28