|
Mit folgendem letztem HTML Mail Body:
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
<title></title>
<style type="text/css">.origmessagetext_quote {margin:0; padding:0; border-left:2px solid blue; padding-left: 5px; }</style>
</head>
<body>
<p><br> </p>
<div id="qu_Dw1FCaKWganRXH5OsOAe" class="origmessagetext">
<p class="MsoNormal" style="margin-bottom: 12.0pt;"><span style="mso-ansi-language: EN-US;" lang="EN-US" data-mce-mark="1">Acceptance date : 06/10/2020<br> Request approved for Max Mustermann <br> Request Date : 06/10/2020 </span></p>
<table class="MsoNormalTable" style="mso-cellspacing: 0cm; mso-yfti-tbllook: 1184; mso-padding-alt: 0cm 0cm 0cm 0cm;" border="1" cellspacing="0" cellpadding="0">
<tbody>
<tr style="mso-yfti-irow: 0; mso-yfti-firstrow: yes;">
<td style="width: 60.0pt; padding: 0cm 0cm 0cm 0cm;" width="80">
<p class="MsoNormal"> Startdate</p>
</td>
<td style="width: 60.0pt; padding: 0cm 0cm 0cm 0cm;" width="80">
<p class="MsoNormal"> Enddate</p>
</td>
<td style="width: 37.5pt; padding: 0cm 0cm 0cm 0cm;" width="50">
<p class="MsoNormal"> Duration (per day)</p>
</td>
<td style="width: 45.0pt; padding: 0cm 0cm 0cm 0cm;" width="60">
<p class="MsoNormal"> Starttime</p>
</td>
</tr>
<tr style="mso-yfti-irow: 1; mso-yfti-lastrow: yes;">
<td style="padding: 0cm 0cm 0cm 0cm;">
<p class="MsoNormal"> 12/10/2020</p>
</td>
<td style="padding: 0cm 0cm 0cm 0cm;">
<p class="MsoNormal"> 12/10/2020</p>
</td>
<td style="padding: 0cm 0cm 0cm 0cm;">
<p class="MsoNormal"> 1</p>
</td>
<td style="padding: 0cm 0cm 0cm 0cm;">
<p class="MsoNormal"> 08:00</p>
</td>
</tr>
</tbody>
</table>
<p class="MsoNormal"><span style="mso-ansi-language: EN-US;" lang="EN-US" data-mce-mark="1"><br> <br> Applicant's Note : This is a test for auto mail to calendar</span></p>
</div>
</body>
</html>
^ Mit dem habe ich es zuletzt getestet.
'#####################################
' Klassenmodul: ThisOutlookSession
'#####################################
'#
'# version: 0.1.3
'# author: Trägheit
'# date: 13.10.2020
'#
'# benötigt Verweis auf:
'# * 'Microsoft HTML Object Library'
'#
Option Explicit
Private Type MailDataType
AcceptanceDate As Date
RequestDate As Date
StartDate As Date
EndDate As Date
DurationPerDay As Integer
RequestFor As String
End Type
'#####################################
'# Dieses Ereignis tritt ein, wenn eine oder mehrere Mails erhalten wurden
'# (Mails = Termine, Terminserien, Aufgabe, Text-Mail, usw.)
Private Sub Application_NewMail()
Dim objItems As Outlook.Items
Set objItems = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
'nach ungelesenen MailItems filtern
Set objItems = objItems.Restrict("[UnRead] = True AND [MessageClass] = 'IPM.Note'")
'aufsteigend sortieren nach Datum
' (Items müssen sortiert werden; ihre Reihenfolge ist sonst unbestimmt)
Call objItems.Sort("SentOn")
Dim objMailItem As Outlook.MailItem
Dim udtMailData As MailDataType
For Each objMailItem In objItems
udtMailData = EmptyMailDataType()
If GetMailData(objMailItem.HTMLBody, udtMailData) Then
'Ausgabe - hier käme dann die Erstellung des Termins / Kalendereintrags
Debug.Print String(15, "-")
Debug.Print "AcceptanceDate: "; udtMailData.AcceptanceDate
Debug.Print " RequestDate: "; udtMailData.RequestDate
Debug.Print " RequestFor: "; "'"; udtMailData.RequestFor; "'"
Debug.Print " From: "; DateValue(udtMailData.StartDate); "(Start: "; TimeValue(udtMailData.StartDate); ")"
Debug.Print " To: "; udtMailData.EndDate
'als gelesen markieren
' objMailItem.UnRead = False
' Call MsgBox("Laden der Daten war erfolgreich.", vbInformation)
Else
' Call MsgBox("Laden der Daten ist leider fehlgeschlagen.", vbExclamation)
End If
Next
End Sub
'#####################################
'# Läd HTML und sucht HTML Tabelle für den Einsprung zum Lesen der Daten
Private Function GetMailData(MailContentHTML As String, ByRef MailData As MailDataType) As Boolean
Dim objHTML As MSHTML.HTMLDocument
Set objHTML = New MSHTML.HTMLDocument
Call CallByName(objHTML, "writeln", VbMethod, MailContentHTML)
With objHTML.DocumentElement
With .getElementsByTagName("TABLE")
If .Length > 0 Then
GetMailData = FetchMailData(.Item(0), MailData)
End If
End With
End With
End Function
'#####################################
'# HTML Daten lesen, mit HTML Tabelle als Einsprungspunkt
Private Function FetchMailData(HTMLTable As MSHTML.HTMLTable, ByRef MailData As MailDataType) As Boolean
On Error GoTo ErrHandler
'# Daten oberhalb von HTMLTable lesen
With CreateObject("VBScript.RegExp")
.Global = True
.IgnoreCase = True
.MultiLine = True
Dim str As String
' "Acceptance date : 06/10/2020"
' "Request approved for Max Mustermann"
' "Request Date : 06/10/2020"
str = HTMLTable.PreviousSibling.innerText
' "Request approved for Max Mustermann" -> "Request approved for : Max Mustermann"
.Pattern = "\bfor\b"
str = .Replace(str, "for :")
' "Acceptance date : 06/10/2020" -> '06/10/2020'
' "Request approved for : Max Mustermann" -> 'Max Mustermann'
' "Request Date : 06/10/2020" -> '06/10/2020'
.Pattern = ":\s*\b(.+)\b\s$"
With .Execute(str)
MailData.AcceptanceDate = DateConv(.Item(0).SubMatches(0))
MailData.RequestFor = .Item(1).SubMatches(0)
MailData.RequestDate = DateConv(.Item(2).SubMatches(0))
End With
End With
'# Daten aus von HTMLTable lesen
Dim tableRow As MSHTML.HTMLTableRow
Dim tableCell As MSHTML.HTMLTableCell
Dim i As Long
With HTMLTable.Rows(1).Cells '1 = zweite Zeile in Tabelle
For i = 0 To .Length - 1
'Wertezuweisung anhand Spaltenindex
Select Case i
Case 0 'Startdate
MailData.StartDate = DateConv(.Item(i).innerText)
Case 1 'Enddate
MailData.EndDate = DateConv(.Item(i).innerText)
Case 2 'Duration (per day)
MailData.DurationPerDay = Trim(.Item(i).innerText)
Case 3 'Starttime
MailData.StartDate = MailData.StartDate + TimeValue(.Item(i).innerText)
End Select
Next
End With
FetchMailData = True
Exit Function
ErrHandler:
FetchMailData = False
MailData = EmptyMailDataType()
End Function
'#####################################
'# Datums-Format handhaben
Private Function DateConv(Expr As String) As Date
With CreateObject("VBScript.RegExp")
.Pattern = "(\d{2})/(\d{2})/(\d{4})"
'#MM/DD/YYYY# #YYYY-MM-DD#
' 06/10/2020' => 2020-06-10
DateConv = DateValue(.Replace(Expr, "$3-$1-$2"))
End With
End Function
'#####################################
'#
Private Function EmptyMailDataType() As MailDataType
'nix zu tun hier - cool! :]
End Function
Um uns beide mal auf den Aktuellen Stand zu bringen. ;)
Grüße
|