Error trying to save xltm as xlsx

[sharky12345]

Hi guys - I'm encountering an error when I try to save a template as a .xlsx file.

The error is object variable or with block variable not set and it appears on line 40 of this code:

Private Sub Workbook_Open()
10    If Sheets("SUMMARY").Range("D2").Value = "" Then
20    AnswerYes = MsgBox("Import Data?", vbQuestion + vbYesNo, "Import")
30    If AnswerYes = vbYes Then
40    ImportFrm.Show
50    End If
60    End If
End Sub

The save routine is here:

Sub SaveFile()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

If InStr(Sheets("SUMMARY").Range("D2").Value, "2023") Then ImportYear = "2023"
If InStr(Sheets("SUMMARY").Range("D2").Value, "2024") Then ImportYear = "2024"

Filename = Sheets("SUMMARY").Range("D2").Value & " Times Data"
FilePath = Drive & "Times\Completed\" & ImportYear

ThisWorkbook.SaveAs Filename:=FilePath & "\" & Filename & ".xlsx", FileFormat:=51

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

The file saves fine, as expected, but I get that error afterwards and I don't understand why - can anyone clear up my confusion?

 

[rlv01]

I tried to replicate your problem, but could not. Though I did discover a few issues in your code. Try this version to see if it makes any difference.

Sub SaveFile()
    Dim ImportYear As String, Filename As String, Drive As String, FilePath As String, FullName As String, Msg As String
    
    Msg = "Performing a 'Save-As' to a new file will abandon any unsaved changed in this workbook ('" & ThisWorkbook.Name & "')" & vbCr & vbCr
    Msg = Msg & "Do you wish to save any changes to '" & ThisWorkbook.Name & "' before proceeding with the 'Save-As' operation?"
    
    Select Case MsgBox(Msg, vbYesNoCancel Or vbQuestion, Application.Name)
        Case vbYes
            ThisWorkbook.Save
        Case vbCancel
            Exit Sub
    End Select
        
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    If InStr(Sheets("SUMMARY").Range("D2").Value, "2023") Then
        ImportYear = "2023"
    ElseIf InStr(Sheets("SUMMARY").Range("D2").Value, "2024") Then
        ImportYear = "2024"
    Else
        MsgBox "'" & Sheets("SUMMARY").Range("D2").Value & _
            "' is not a valid year.", vbCritical, "Data Error"
        Exit Sub
    End If
    
    Drive = "C:\"   '<-- edit as required
    Filename = Sheets("SUMMARY").Range("D2").Value & " Times Data"
    FilePath = Drive & "Times\Completed\" & ImportYear
    FilePath = "C:\Users\223103252\Documents\TestFiles"
    
    With CreateObject("Scripting.FileSystemObject")
        If Not .FolderExists(FilePath) Then
            MsgBox "Folder '" & FilePath & "' does not exist.", vbCritical, _
                "Folder Error"
            Exit Sub
        End If
    End With
    
    FullName = FilePath & "\" & Filename & ".xlsx"
    
    ThisWorkbook.SaveAs Filename:=FullName, FileFormat:=51
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

 

[rlv01]

An alternate approach to the above.

'Save a copy of current Workbook a new file format while keeping the original workbook open.
Sub SaveFileV2()
    Dim ImportYear As String, Filename As String, Drive As String, FilePath As String, FullName As String, TempFilePath As String
    Dim DestWB As Workbook
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    If InStr(Sheets("SUMMARY").Range("D2").Value, "2023") Then
        ImportYear = "2023"
    ElseIf InStr(Sheets("SUMMARY").Range("D2").Value, "2024") Then
        ImportYear = "2024"
    Else
        MsgBox "'" & Sheets("SUMMARY").Range("D2").Value & _
        "' is not a valid year.", vbCritical, "Data Error"
        Exit Sub
    End If
    
    Drive = "C:\"
    Filename = Sheets("SUMMARY").Range("D2").Value & " Times Data"
    FilePath = Drive & "Times\Completed\" & ImportYear
    FilePath = "C:\Users\223103252\Documents\TestFiles"
    
    With CreateObject("Scripting.FileSystemObject")
        If Not .FolderExists(FilePath) Then
            MsgBox "Folder '" & FilePath & "' does not exist.", vbCritical, _
            "Folder Error"
            Exit Sub
        End If
        TempFilePath = FilePath & "\TmpFile$." & .GetExtensionName(ThisWorkbook.Name)
    End With
    
    ThisWorkbook.SaveCopyAs (TempFilePath)
    DoEvents
    Set DestWB = Application.Workbooks.Open(Filename:=TempFilePath)
    DoEvents
    
    FullName = FilePath & "\" & Filename & ".xlsx"
    
    DestWB.SaveAs Filename:=FullName, FileFormat:=51
    DestWB.Close False
    DoEvents
    Kill TempFilePath
    
    MsgBox "New File Created:" & vbCr & vbCr & FullName, vbInformation
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

 

[sharky12345]

An alternate approach to the above.

'Save a copy of current Workbook a new file format while keeping the original workbook open.
Sub SaveFileV2()
    Dim ImportYear As String, Filename As String, Drive As String, FilePath As String, FullName As String, TempFilePath As String
    Dim DestWB As Workbook
   
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
   
    If InStr(Sheets("SUMMARY").Range("D2").Value, "2023") Then
        ImportYear = "2023"
    ElseIf InStr(Sheets("SUMMARY").Range("D2").Value, "2024") Then
        ImportYear = "2024"
    Else
        MsgBox "'" & Sheets("SUMMARY").Range("D2").Value & _
        "' is not a valid year.", vbCritical, "Data Error"
        Exit Sub
    End If
   
    Drive = "C:\"
    Filename = Sheets("SUMMARY").Range("D2").Value & " Times Data"
    FilePath = Drive & "Times\Completed\" & ImportYear
    FilePath = "C:\Users\223103252\Documents\TestFiles"
   
    With CreateObject("Scripting.FileSystemObject")
        If Not .FolderExists(FilePath) Then
            MsgBox "Folder '" & FilePath & "' does not exist.", vbCritical, _
            "Folder Error"
            Exit Sub
        End If
        TempFilePath = FilePath & "\TmpFile$." & .GetExtensionName(ThisWorkbook.Name)
    End With
   
    ThisWorkbook.SaveCopyAs (TempFilePath)
    DoEvents
    Set DestWB = Application.Workbooks.Open(Filename:=TempFilePath)
    DoEvents
   
    FullName = FilePath & "\" & Filename & ".xlsx"
   
    DestWB.SaveAs Filename:=FullName, FileFormat:=51
    DestWB.Close False
    DoEvents
    Kill TempFilePath
   
    MsgBox "New File Created:" & vbCr & vbCr & FullName, vbInformation
   
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Thanks very much, I'll give it a try