Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2
Sub mail_aus_vorlage()
Dim outlook As Object
Dim neueNachricht As Object
Dim betreff As String
Dim text As String
Dim pfad1 As String, pfad2 As String, pfad3 As String, speicherpfad As String
Dim I As Long
Dim datum, zeit, ort
Dim ekonto
Dim nachricht
Dim inbox
Dim zahler
Dim pfad(3)
Dim handle As Long
Dim RetVal1 As Long
Dim RetVal2 As Long
Dim textclass As String
Dim textname As String
Dim anzahl As Long
pfad(1) = "Pfad der ersten Vorlage mit Name auf .oft"
pfad(2) = "Pfad der zweiten Vorlage mit Name auf .oft"
pfad(3) = "Pfad der dritten Vorlage mit Name auf .oft"
speicherpfad = "Pfad zum Abspeichern endet mt \"
Set outlook = CreateObject("Outlook.Application")
For I = 1 To 3
Set neueNachricht = outlook.CreateItemFromTemplate(pfad(I))
betreff = neueNachricht.Subject
text = neueNachricht.body
betreff = Format(datum, "yyyymmdd") & betreff
neueNachricht.Subject = betreff
Select Case neueNachricht.bodyformat
Case 1
text = neueNachricht.body
text = Replace(text, "<DATUM>", datum)
text = Replace(text, "<UHRZEIT>", zeit)
text = Replace(text, "<ORT>", ort)
neueNachricht.body = text
Case 2
text = neueNachricht.htmlbody
text = Replace(text, "<DATUM>", datum)
text = Replace(text, "<UHRZEIT>", zeit)
text = Replace(text, "<ORT>", ort)
neueNachricht.htmlbody = text
Case Else
End Select
neueNachricht.display True
Set neueNachricht = Nothing
Next I
anzahl = 3
While anzahl <> 0
anzahl = 0
handle = GetDesktopWindow()
handle = GetWindow(handle, GW_CHILD)
Do While handle <> 0
textclass = String(255, 0)
RetVal = GetClassName(handle, textclass, Len(textclass))
If Mid(textclass, 1, RetVal) = "rctrl_renwnd32" Then
textname = String(255, 0)
RetVal2 = GetWindowText(handle, textname, Len(textname))
textxname = Mid(textname, 1, RetVal2)
If Left(textname, 8) = Format(datum, "yyyymmdd") And InStr(1, textname, "- Nachricht (", vbTextCompare) > 0 Then
If IsWindowVisible(handle) Then
anzahl = anzahl + 1
End If
End If
End If
handle = GetWindow(handle, GW_HWNDNEXT)
DoEvents
Loop
Wend
zahler = 0
Set outlook = CreateObject("Outlook.Application")
Set ekonto = outlook.GetNamespace("MAPI")
Set inbox = ekonto.GetDefaultFolder(5)
For Each nachricht In inbox.items
If zahler < 4 Then
If Left(nachricht.Subject, 8) = Format(datum, "yyyymmdd") Then
nachricht.SaveAs speicherpfad & nachricht.Subject & ".msg"
zahler = zahler + 1
End If
End If
Next nachricht
End Sub