Hallo ClaGo,
ich will ja jetzt nichts durcheinanderbringen, aber bist Du jetzt schon durch mit dem Thema? Terminsetzungen sehe ich in den vorgelegten Codes jetzt noch nicht, oder sehe ich das falsch?
Ich habe jetzt für mich mal die neuesten Erkenntnisse von Trägheits code in eine neue reduzierte Variante mit den relevanten Elementen eingefügt und bei mir funktioniert jetzt die Terminerstellung aus der entsprechenden Mail einwandfrei. Natürlich weiß ich nicht genau, was da noch alles in den Termin soll.
eMail-Adresse bzw. den Text für das Postfach noch anpassen, dann sollte es funzen....
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("volti@mail.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, CreateItem(1)) 'Termin aus Mail erstellen
End If
End If
Next oMail
End With
End Sub
Sub SetzeTermin(oMail As Object, oTermin As Object)
Dim objHTML As MSHTML.HTMLDocument
Dim oNode As Object, sArr() As String
Dim iSpalte As Long
Dim sStart As String, sEnde As String, sTime As String
Dim 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
With oNode.rows(1).cells(iSpalte)
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 oTermin
.Start = Format(sStart, "dd.mm.yyyy") & " " & sTime 'Startdatum und Uhrzeit
.End = Format(sEnde, "dd.mm.yyyy") & " " & 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
Set oTermin = Nothing
End Sub
viele Grüße
Karl-Heinz
|