Hallo Freunde*innen,
als mittelmäßiger VBA-Nutzer habe ich ein Problem mit Outlook.
Ich möchte im Posteingang nach bestimmeten Begriffen im Betreff suchen und bei einem Treffer die Mail in einen Systemordner verschieben.
Dann sollen die Mails gelöscht werden.
Wenn zwei Mails mit dem Suchbegriff gefunden werden geht es wunderbar.
Bei drei Mails wird eine nicht übertragen, bei fünf zwei usw.
Wo liegt das Problem?
Vielen Dank für Eure Bemühungen.
Gruß Fredo
Public Sub suchen_speichern()
Dim olapp As New Outlook.Application
Dim olmails As Object
Dim ordner As Object
Dim mails As Outlook.MailItem
anzahl = 0
'wohin speichern?
strPath = Environ("USERPROFILE") & "\Documents\"
Set olapp = CreateObject("Outlook.Application")
Set olmails = olapp.GetNamespace("MAPI")
Set ordner = olmails.GetDefaultFolder(olFolderInbox)
'alle mails im ordner prüfen
suchbegriff = "$$$$$"
For Each mails In ordner.Items
If InStr(1, mails.Subject, suchbegriff, vbTextCompare) Then
With mails
strText = Replace(.Subject, "/", "_")
strText = Replace(strText, "!", "")
strText = Replace(strText, ".", "_")
strText = Replace(strText, "\", "_")
strText = Replace(strText, ":", "_")
strText = Replace(strText, "(", "")
strText = Replace(strText, ")", "")
strText = Replace(strText, """", "")
'und abspeichern - olmsg = Outlook-Nachrichtenformat (MSG)
.SaveAs strPath & strText & ".msg", olMSG
.Delete
anzahl = anzahl + 1
End With
End If
Next mails
'fertig
MsgBox "Fertig - " & anzahl & " Mails übertragen"
End Sub
|