Vorlage für Mail? in VBA

[elamigo]

Guten Tag da meine letzten Beiträge ins Leere gelaufen sind, frage ich mal an dieser Stelle allgemein. 

Gibt es eine Möglichkeit über Excel Mails zu versenden welche auf eine Vorlage zurück greifen? Also entwedern Word oder Outlook mail o.ä.?

[00202]

Hallo, :19:

das geht doch recht einfach über eine ".oft - Datei": :21:

Code:

Option Explicit
Public Sub Main()
    Dim objOutlook
    Dim objVorlage
    Set objOutlook = CreateObject("Outlook.Application")
    ' Pfad- und Dateiname anpassen!!!
    Set objVorlage = objOutlook.CreateItemFromTemplate("C:\Temp\MeineVorlage.oft")
    objVorlage.Display
    Set objVorlage = Nothing
    Set objOutlook = Nothing
End Sub

[steve1da]

Hola,

zur Info...

https://www.ms-office-forum.net/forum/sh...p?t=357209

Gruß,
steve1da

[MisterBurns]

da meine letzten Beiträge ins Leere gelaufen sind

Ich möchte darauf hinweisen, dass die von dir erwähnten Beiträge zum aktuellen Zeitpunkt noch keine 24 Stunden online sind.

1. Das empfinde ich nicht als die angemessene Zeit, um auf eine Antwort zu warten. Und schon gar nicht, dass die Beiträge "ins Leere gelaufen sind".
2. Du wurdest bereits darauf hingewiesen, dass auf Crossposting zumindest hingewiesen werden sollte, aus Fairness den Helfern gegenüber.
3. Wenn man auf Beiträge keine Antwort bekommt, kann schlechte Fragestellung ein Grund sein. Das würde ich für die betreffenden Beiträge jedoch nicht so sehen, die Fragen erscheinen mir ordentlich gestellt. Dennoch kannst du guten Gewissens nach einem Tag (ist jetzt mal eine nach meinem Gefühl angemessene Zeit, kann jeder für sich selbst entscheiden) den Beitrag nochmals pushen und nachfragen, ob denn noch Infos fehlen oder was der Grund sein könnte, dass Antworten ausbleiben.

[elamigo]

Danke Steve für das CP habe es vergessen!


@case
Danke schon mal, sowas in der Art hatte ich auch schon allerdings gelingt mir die Implementierung in meinen Email Code leider nicht. :( Kannst du mir vllt helfen? 

Code:

Private Sub CommandButton2_Click()
   Dim objOutlook
   Dim objVorlage
   Set objOutlook = CreateObject("Outlook.Application")
   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
               
   

   '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 "\XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXFORUM" & TempFileName & FileExtStr, FileFormat:=FileFormatNum, Password:="123321", ReadOnlyRecommended:=False, CreateBackup:=False
       On Error Resume Next
       With OutMail
           .To = ""
           .CC = ""
           .BCC = ""
           .Subject = ""
           .Body = ""
           .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

[elamigo]

Alles klar Berni ist notiert; für die Zukunft übe ich mich mehr in Geduld! Sorry.

[00202]

Hallo, :19:

du musst statt...

Code:

Set OutMail = OutApp.CreateItem(0)

... das nehmen:

Code:

Set OutMail = OutApp.CreateItemFromTemplate("PfadundDateinameDeinerVorlagenDatei")

Pfad- und Dateiname deiner Vorlagendatei zwischen den Anführungszeichen anpassen. :21:

[elamigo]

DANKE!