Hallo ClaGo,
wenn Du eine neue Mail erstellen möchtest, also nicht einfach die gerade bearebietete Mail weiterleiten möchtests, kannst Du das unten eingebaute Muster verwenden.
Ich habe ein HTML-Format verwendet, welches Du jetzt nach Deinem Geschmack formatieren könntest:
Option Explicit
'Dieses Ereignis tritt auf, wenn eine oder mehrere Mails erhalten wurden
Private Sub Application_NewMail()
Dim oItems As Object, oMail As Object
With GetNamespace("MAPI").Folders("voltmann-khan@t-online.de").Folders("Posteingang").Items
'Nach ungelesenen Mails filtern
Set oItems = .Restrict("[UnRead] = True")
Call oItems.Sort("SentOn") 'aufsteigend sortieren nach Datum
For Each oMail In oItems
If TypeOf oMail Is Outlook.MailItem Then 'Nur Mails, keine Termine
If oMail.Subject Like "*Information MAIL*" Then
Call SetzeTermin(oMail) 'Termin aus Mail erstellen
oMail.UnRead = False
End If
End If
Next oMail
End With
End Sub
Sub SetzeTermin(oMail As Object)
Dim objHTML As MSHTML.HTMLDocument
Dim oNode As Object, sArr() As String, iSpalte As Long
Dim sStart As String, sEnde As String, sTime As String, sBetreff As String
Set objHTML = New MSHTML.HTMLDocument
'Mail bearbeiten
With oMail
Call CallByName(objHTML, "writeln", VbMethod, .HTMLBody)
'Terminelemente aus der Mail-Tabelle extrahieren
Set oNode = objHTML.DocumentElement.getElementsByTagName("TABLE")(0)
If Not oNode Is Nothing Then
'Namen des Antragstellers als Betreff extrahieren
sBetreff = Split(oNode.PreviousSibling.innerText & vbCrLf, vbCrLf)(1)
sBetreff = Split(sBetreff & " for ", " for ")(1)
'Zeiten extrahieren
For iSpalte = 0 To oNode.Rows(1).Cells.Length - 1 'Spaltenanzahl aus zweiter Zeile ermitteln
With oNode.Rows(1).Cells(iSpalte) '2. Zeile enthält die Werte
Select Case Trim$(oNode.Rows(0).Cells(iSpalte).innerText)
Case "Startdate": sStart = Trim$(.innerText)
Case "Enddate": sEnde = Trim$(.innerText)
Case "Starttime": sTime = Trim$(.innerText)
End Select
End With
Next iSpalte
End If
End With
'Jetzt den Termin erstellen
With CreateItem(1)
.Start = DateValue(sStart) & " " & TimeValue(sTime) 'Startdatum und Uhrzeit
.End = DateValue(sEnde) & " " & TimeValue(sTime) 'Endedatum und Uhrzeit
.Subject = sBetreff 'Betreff einfügen
.Body = "Termin für " & sBetreff 'Body-Angaben
.Location = "Ort nicht angegeben" 'Ggf. Ort hinzufügen
.Save 'Termin speichern
.Display 'und anzeigen
End With
'und eine eMail neu erstellen
With CreateItem(0)
.BodyFormat = 2 'HTML-Format, Angabe optional
.To = "MeinEmpfaenger@Mail.de;Nocheiner@Mail.de"
' .CC = "MeinEmpfaenger@Mail.de"
.Subject = sBetreff
.GetInspector
.HTMLBody = "<span style='font-family:Arial; font-size:10pt;color:#000000'>" _
& "Hallo,<br><br>hier der Termin:<br><br>" _
& "<table border=0 cellpadding=0 cellspacing=0>" _
& "<tr><td>Starttermin:</td><td> </td><td>" & sStart & "</td></tr>" _
& "<tr><td>Endtermin:</td><td> </td><td>" & sEnde & "</td></tr>" _
& "</table><br></span>" & .HTMLBody
.Display
End With
End Sub
viele Grüße
Karl-Heinz
|