Email Datei nicht korrekt

[elamigo]

Guten Tag Leute,

habe eine Tabelle mit Makros. Eins davon sendet eine Email der ausgewählten Tabellenblätter (Auswahl über ListBox). Wenn ich im Code nichts änder setzt er die Farben, der neuen Datei auf Office, ich brauche aber Office 2007-2010. Wenn ich nun folgendes einfüge 

Code:

ActiveWorkbook.Theme.ThemeColorScheme.Load ( _
     "C:\Program Files (x86)\Microsoft Office\Document Themes 16\Theme Colors\Office 2007 - 2010.xml" _
    )

lädt er mir in der Theorie die richtigen Farben drauf. Allerdings öffnet er mir manchmal nicht outlook und erstellt nur eine Datei, mit den ausgewählten Arbeitsblättern und nennt Sie "MappeXX". Also keine Fehlermeldung er macht einfach nur etwas anderes. Wenn ich dann den obigen code weg lasse, ein Durchlauf mache, dann den Code wieder einfüge, dann funktioniert wieder alles wie gewohnt. 
Hier der ganze Code: 

Code:

Private Sub CommandButton2_Click()

   Dim FileExtStr As String
   Dim FileFormatNum As Long
   Dim Sourcewb As Workbook
   Dim Destwb As Workbook
   Dim TempFilePath As String
   Dim TempFileName As String
   Dim OutApp As Object
   Dim OutMail As Object
   Dim lngSheet As Long
   Dim lngTMP As Long
   Dim varArrSheets() As Variant
   On Error GoTo Fin
   If ListBox1.ListCount = 0 Then
       MsgBox "Es wurden keine Tabellenblätter gewählt.", vbOKOnly + vbExclamation, "Warnung"
       Exit Sub
   Else
       For lngTMP = 0 To ListBox1.ListCount - 1
           If ListBox1.Selected(lngTMP) Then
               ReDim Preserve varArrSheets(lngSheet)
               varArrSheets(lngSheet) = ListBox1.List(lngTMP)
               lngSheet = lngSheet + 1
           End If
       Next lngTMP
   End If
   
   With Application
       .ScreenUpdating = False
       .EnableEvents = False
       .DisplayAlerts = False
   End With

   Set Sourcewb = ActiveWorkbook

   'Copy the ActiveSheet to a new workbook
   
   'ActiveSheet.Copy
   
   ThisWorkbook.Worksheets(varArrSheets).Copy
   
   Set Destwb = ActiveWorkbook
               
   
   ActiveWorkbook.Theme.ThemeColorScheme.Load ( _
     "C:\Program Files (x86)\Microsoft Office\Document Themes 16\Theme Colors\Office 2007 - 2010.xml" _
    )
   

   'Determine the Excel version and file extension/format
   With Destwb
   
          If Val(Application.Version) < 12 Then
           'You use Excel 97-2003
           FileExtStr = ".xls": FileFormatNum = -4143
       Else
           'You use Excel 2007-2016
           Select Case Sourcewb.FileFormat
           Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
           Case 52:
               If .HasVBProject Then
                   FileExtStr = ".xlsm": FileFormatNum = 52
               Else
                   FileExtStr = ".xlsx": FileFormatNum = 51
               End If
           Case 56: FileExtStr = ".xls": FileFormatNum = 56
           Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
           End Select
       End If
   End With



   'Save the new workbook/Mail it/Delete it
   ' Pfad anpassen - abschliessenden Backslash nicht vergessen!!!
   
 
   TempFilePath = Environ$("temp") & "\"
   TempFileName = TextBoxDatei.Text

   Set OutApp = CreateObject("Outlook.Application")
   Set OutMail = OutApp.CreateItem(0)
   
   With Destwb
       .SaveAs "S:\XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" & TempFileName & FileExtStr, FileFormat:=FileFormatNum
       On Error Resume Next
       With OutMail
           .To = ""
           .CC = ""
           .BCC = ""
           .Subject = "Test"
           .Body = "Hallo anbei die Tabelle"
           .Attachments.Add Destwb.FullName
           
           'Anhang hinzufügen
           '.Attachments.Add ("U:\Test für Senden.xlsx")
           '.Send or use
           .Display
       End With
       On Error GoTo 0
       .Close savechanges:=False
   End With

   'Delete the file you have send
   
   'Kill TempFilePath & TempFileName & FileExtStr
Fin:
   Set OutMail = Nothing
   Set OutApp = Nothing

   With Application
       .ScreenUpdating = True
       .EnableEvents = True
       .DisplayAlerts = True
   End With
   
   Unload UserForm1
   
End Sub

leider ist eine korrekte Farbauswahl in diesem Fall unerlässlich. 
Etwas komisch das Ganze.

[schauan]

Hallöchen,

eventuell nimmst Du erst mal On Error... raus und schaust und verrätst uns, was dann für eine Meldung kommt.

On Error sollte man sehr gezielt einsetzen - insbesondere bei der Entwicklung - und für den späteren Einsatz ggf. auch nach der Sprungmarke eine Meldung programmieren, z.B.:
If err Then Msgbox "Fehler: " & err.number & vblf & err.description

[elamigo]

alles klar ich schau mir das mal an!