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.ä.?
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
Zitat: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.
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
Alles klar Berni ist notiert; für die Zukunft übe ich mich mehr in Geduld! Sorry.
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:
