Hallo zusammen,

Ich habe dieses VBA -Script schon einige Zeit am laufen, funktionierte auch einwandfrei.

Jetzt hat man in der Firma das neue Excel 2016 installiert und jetzt bekomme ich immer eine Fehlermeldung (Projekt oder Bibliothek nicht gefunden).

Was muss ich ändern, damit das Script auch wieder auf Excel 2016 läuft? Kann mir jemand bitte weiterhelfen?

Sub TabellenblattVerschicken()

     Dim Source As Range
     Dim Dest As Workbook
     Dim wb As Workbook
     Dim TempFilePath As String
     Dim TempFileName As String
     Dim FileExtStr As String
     Dim FileFormatNum As Long
     Dim OutApp As Object
     Dim OutMail As Object

     Set Source = Nothing
     On Error Resume Next
     Set Source = Range("B1:I56").SpecialCells(xlCellTypeVisible)
     On Error GoTo 0

     If Source Is Nothing Then
         MsgBox "The source is not a range or the sheet is protected, " & _
                "please correct and try again.", vbOKOnly
         Exit Sub
     End If

     With Application
         .ScreenUpdating = False
         .EnableEvents = False
     End With

     Set wb = ActiveWorkbook
     Set Dest = Workbooks.Add(xlWBATWorksheet)
     Source.Copy
     With Dest.Sheets(1)
         .Cells(1).PasteSpecial Paste:=8
         .Cells(1).PasteSpecial Paste:=xlPasteValues
         .Cells(1).PasteSpecial Paste:=xlPasteFormats
         .Cells(1).Select
         Application.CutCopyMode = False
     End With

     TempFilePath = Environ$("temp") & "\"
     TempFileName = "Selection of " & wb.name & " " _
                  & Format(Now, "dd-mmm-yy h-mm-ss")

     If Val(Application.Version) < 12 Then
         'You use Excel 2000-2003
         FileExtStr = ".xls": FileFormatNum = -4143
     Else
         'You use Excel 2007-2010
         FileExtStr = ".xlsx": FileFormatNum = 51
     End If

     Set OutApp = CreateObject("Outlook.Application")
     Set OutMail = OutApp.CreateItem(0)

     With Dest
         .SaveAs TempFilePath & TempFileName & FileExtStr, _
                 FileFormat:=FileFormatNum
         On Error Resume Next
         With OutMail
             .GetInspector
             .To = "xxxxxxx@xxx.com "
             .CC = ""
             .BCC = ""
             .Subject = "Test "
             .Body = "Test" & vbCrLf & .Body
             .Attachments.Add Dest.FullName
  
             .Display
         
         End With
         On Error GoTo 0
         .Close SaveChanges:=False
     End With

     Kill TempFilePath & TempFileName & FileExtStr

     Set OutMail = Nothing
     Set OutApp = Nothing

     With Application
         .ScreenUpdating = True
         .EnableEvents = True
     End With
     
End Sub