VBA how to prevent workbook from creating "Book1 - Excel"

[Pinaceous]

Good Day All,

I'm using the sub SaveAsXLSM below to create a new workbook based upon the date.

    Dim strName As String
    
    strName = ThisWorkbook.Path & "\" & Format(Date, "DDMMMYYYY ") & Sheet1.Name & " " & ".xlsm"
    
    ActiveSheet.Copy
    ThisWorkbook.SaveAs FileName:=strName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    ActiveWorkbook.Close savechanges:=False

At times depending upon the computer speed provides a "Book1 - Excel" file as an error file.

My question is, how do prevent this type of event/error from happening?

For example,

 On Error GoTo Whoa

'code

LetsContinue:

  If strWBName = "Book1.xlsx" created Then

 Don't 

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Exit Sub
    
Whoa:
    'MsgBox Err.Description
    Resume LetsContinue

Please let me know.

Thank you!
pinaceous

 

[rabsofty]

try putting a pause between activesheet.copy and thisworkbook,saveas


eg:

ActiveSheet.Copy
Call pausemacro(3)
ThisWorkbook.SaveAs FileName:=strName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
ActiveWorkbook.Close savechanges:=False

Sub pausemacro(delaysec)
'pause4 (delaysec) secs
  newHour = Hour(Now()): newMinute = Minute(Now()): newSecond = Second(Now()) + delaysec
  waitTime = TimeSerial(newHour, newMinute, newSecond): Application.Wait waitTime
End Sub

waitTime = TimeSerial(newHour, newMinute, newSecond): Application.Wait waitTime
End Sub

 

[RoryA]

I don't understand your code. It says to copy the activesheet - which creates a new, active workbook - then save the workbook with the code in it, then close the workbook you just created without saving it. What was the point?

 

[Pinaceous]

Not sure where Post#2 was going but this is the solution that I came up with:

Sub CloseOtherWorkbook()
Dim xWB As Workbook
Application.ScreenUpdating = False
For Each xWB In Application.Workbooks
    If Not (xWB Is Application.ActiveWorkbook) Then
        xWB.Close
    End If
Next
Application.ScreenUpdating = True
End Sub

Thank you for posting!
pinaceous

 

[rabsofty]

made an error with my eyes