Public WithEvents App As Excel.Application

Private Sub App_WorkbookBeforeSave( _
  ByVal Wb As Workbook, _
  ByVal SaveAsUI As Boolean, _
  Cancel As Boolean)
    Dim strFileName As String
    Static lngCount As Long
    
    strFileName = "D:\1\"
    
    Cancel = True

    With App
        .EnableEvents = False
        Wb.SaveAs strFileName & (lngCount +  1 ) & ".xls"
        .EnableEvents = True
    End With
        
    lngCount = lngCount +  1 
End Sub

Dim a As New Class1

Private Sub Workbook_Open()
    Set a.App = Excel.Application
End Sub