Thema Datum  Von Nutzer Rating
Antwort
06.10.2020 11:56:44 ClaGo
Solved
06.10.2020 14:16:38 volti
NotSolved
07.10.2020 11:19:09 ClaGo
NotSolved
07.10.2020 15:41:47 volti
NotSolved
08.10.2020 14:48:54 Goetz Claude
NotSolved
08.10.2020 15:26:29 Trägheit
**
NotSolved
08.10.2020 15:41:51 Gast81327
**
NotSolved
08.10.2020 18:02:23 volti
NotSolved
08.10.2020 17:26:46 Gast9628
*
NotSolved
09.10.2020 09:17:15 Gast5782
NotSolved
09.10.2020 10:29:06 Gast63633
NotSolved
09.10.2020 11:21:15 Trägheit
NotSolved
09.10.2020 18:06:14 Trägheit
***
NotSolved
09.10.2020 18:15:11 Trägheit
**
NotSolved
09.10.2020 18:19:15 Trägheit
*
NotSolved
12.10.2020 14:51:27 ClaGo
NotSolved
12.10.2020 15:31:50 ClaGo
NotSolved
12.10.2020 16:44:05 Trägheit
**
NotSolved
13.10.2020 11:13:52 ClaGo
NotSolved
Blau mit aktuellem Mail Body und aktuellem Makro-Stand
13.10.2020 11:56:36 Trägheit
NotSolved
13.10.2020 12:00:13 Trägheit
****
NotSolved
13.10.2020 15:00:26 ClaGo
NotSolved
13.10.2020 15:47:24 Trägheit
NotSolved
13.10.2020 16:09:39 Short Interrupt
NotSolved
14.10.2020 08:30:59 ClaGo
NotSolved
14.10.2020 12:58:45 Trägheit
NotSolved
14.10.2020 13:29:56 Gast71137
NotSolved
14.10.2020 13:34:34 Gast18503
NotSolved
14.10.2020 18:48:08 volti
NotSolved
14.10.2020 19:28:21 Gast75504
NotSolved
14.10.2020 21:22:46 Trägheit
NotSolved
15.10.2020 10:32:07 ClaGo
NotSolved
15.10.2020 12:14:59 Gast74427
NotSolved
15.10.2020 13:53:49 Trägheit
NotSolved
15.10.2020 14:18:23 Gast41485
NotSolved
15.10.2020 16:18:37 ClaGo
NotSolved
15.10.2020 16:37:19 Gast17356
NotSolved
16.10.2020 08:48:22 ClaGo
NotSolved
16.10.2020 09:56:53 volti
NotSolved
16.10.2020 10:42:09 ClaGo
NotSolved
16.10.2020 17:28:10 volti
NotSolved
15.10.2020 13:35:54 Trägheit
NotSolved
16.10.2020 11:03:16 Gast34587
Solved
19.10.2020 13:03:56 ClaGo
Solved
19.10.2020 14:09:13 Gast73229
NotSolved
19.10.2020 14:34:42 Trägheit
NotSolved
21.10.2020 14:16:04 ClaGo
NotSolved
21.10.2020 14:45:03 Trägheit
NotSolved
21.10.2020 14:57:27 Trägheit
NotSolved
21.10.2020 16:07:29 Trägheit
**
NotSolved
21.10.2020 16:10:04 Gast1841
NotSolved
21.10.2020 16:11:49 Gast5396
NotSolved
21.10.2020 15:10:53 Trägheit
NotSolved
22.10.2020 08:24:49 clago
NotSolved
22.10.2020 08:58:27 volti
Solved

Ansicht des Beitrags:
Von:
Trägheit
Datum:
13.10.2020 11:56:36
Views:
738
Rating: Antwort:
  Ja
Thema:
mit aktuellem Mail Body und aktuellem Makro-Stand

Mit folgendem letztem HTML Mail Body:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
<!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">&nbsp;Startdate</p>
                  </td>
                  <td style="width: 60.0pt; padding: 0cm 0cm 0cm 0cm;" width="80">
                     <p class="MsoNormal">&nbsp;Enddate</p>
                  </td>
                  <td style="width: 37.5pt; padding: 0cm 0cm 0cm 0cm;" width="50">
                     <p class="MsoNormal">&nbsp;Duration (per day)</p>
                  </td>
                  <td style="width: 45.0pt; padding: 0cm 0cm 0cm 0cm;" width="60">
                     <p class="MsoNormal">&nbsp;Starttime</p>
                  </td>
               </tr>
               <tr style="mso-yfti-irow: 1; mso-yfti-lastrow: yes;">
                  <td style="padding: 0cm 0cm 0cm 0cm;">
                     <p class="MsoNormal">&nbsp;12/10/2020</p>
                  </td>
                  <td style="padding: 0cm 0cm 0cm 0cm;">
                     <p class="MsoNormal">&nbsp;12/10/2020</p>
                  </td>
                  <td style="padding: 0cm 0cm 0cm 0cm;">
                     <p class="MsoNormal">&nbsp;1</p>
                  </td>
                  <td style="padding: 0cm 0cm 0cm 0cm;">
                     <p class="MsoNormal">&nbsp;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.


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
'#####################################
' 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


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
06.10.2020 11:56:44 ClaGo
Solved
06.10.2020 14:16:38 volti
NotSolved
07.10.2020 11:19:09 ClaGo
NotSolved
07.10.2020 15:41:47 volti
NotSolved
08.10.2020 14:48:54 Goetz Claude
NotSolved
08.10.2020 15:26:29 Trägheit
**
NotSolved
08.10.2020 15:41:51 Gast81327
**
NotSolved
08.10.2020 18:02:23 volti
NotSolved
08.10.2020 17:26:46 Gast9628
*
NotSolved
09.10.2020 09:17:15 Gast5782
NotSolved
09.10.2020 10:29:06 Gast63633
NotSolved
09.10.2020 11:21:15 Trägheit
NotSolved
09.10.2020 18:06:14 Trägheit
***
NotSolved
09.10.2020 18:15:11 Trägheit
**
NotSolved
09.10.2020 18:19:15 Trägheit
*
NotSolved
12.10.2020 14:51:27 ClaGo
NotSolved
12.10.2020 15:31:50 ClaGo
NotSolved
12.10.2020 16:44:05 Trägheit
**
NotSolved
13.10.2020 11:13:52 ClaGo
NotSolved
Blau mit aktuellem Mail Body und aktuellem Makro-Stand
13.10.2020 11:56:36 Trägheit
NotSolved
13.10.2020 12:00:13 Trägheit
****
NotSolved
13.10.2020 15:00:26 ClaGo
NotSolved
13.10.2020 15:47:24 Trägheit
NotSolved
13.10.2020 16:09:39 Short Interrupt
NotSolved
14.10.2020 08:30:59 ClaGo
NotSolved
14.10.2020 12:58:45 Trägheit
NotSolved
14.10.2020 13:29:56 Gast71137
NotSolved
14.10.2020 13:34:34 Gast18503
NotSolved
14.10.2020 18:48:08 volti
NotSolved
14.10.2020 19:28:21 Gast75504
NotSolved
14.10.2020 21:22:46 Trägheit
NotSolved
15.10.2020 10:32:07 ClaGo
NotSolved
15.10.2020 12:14:59 Gast74427
NotSolved
15.10.2020 13:53:49 Trägheit
NotSolved
15.10.2020 14:18:23 Gast41485
NotSolved
15.10.2020 16:18:37 ClaGo
NotSolved
15.10.2020 16:37:19 Gast17356
NotSolved
16.10.2020 08:48:22 ClaGo
NotSolved
16.10.2020 09:56:53 volti
NotSolved
16.10.2020 10:42:09 ClaGo
NotSolved
16.10.2020 17:28:10 volti
NotSolved
15.10.2020 13:35:54 Trägheit
NotSolved
16.10.2020 11:03:16 Gast34587
Solved
19.10.2020 13:03:56 ClaGo
Solved
19.10.2020 14:09:13 Gast73229
NotSolved
19.10.2020 14:34:42 Trägheit
NotSolved
21.10.2020 14:16:04 ClaGo
NotSolved
21.10.2020 14:45:03 Trägheit
NotSolved
21.10.2020 14:57:27 Trägheit
NotSolved
21.10.2020 16:07:29 Trägheit
**
NotSolved
21.10.2020 16:10:04 Gast1841
NotSolved
21.10.2020 16:11:49 Gast5396
NotSolved
21.10.2020 15:10:53 Trägheit
NotSolved
22.10.2020 08:24:49 clago
NotSolved
22.10.2020 08:58:27 volti
Solved