Hallo zusammen,
ich versuche gerade ein kleines Programm für Outlook zu schreiben, welches mir doppelte Mails erkennt und dann diese markiert und in einen Outlookordner verschieben soll.
Das Finden und Markieren ist nicht das Problem, aber das Verschieben. Grundsätzlich funktioniert das Verschieben mit einem festen "Pfad" natürlich, aber dieser soll aus einer Textbox heraus genommen werden. Diese Textbox wird über einen Button 'Btn_OutlookZielOrdner_Click' mit der Auswahl des Outlook-Ordners gefüllt. So kann das Programm variable genutzt werden.
Nur hierbei habe ich im Netz leider keine Lösung gefunden, wie ich den Ordner ansprechen kann.
Kann mir von Euch jemand einen Tipp geben?
Spoiler anzeigen
Gruß
Volker
ich versuche gerade ein kleines Programm für Outlook zu schreiben, welches mir doppelte Mails erkennt und dann diese markiert und in einen Outlookordner verschieben soll.
Das Finden und Markieren ist nicht das Problem, aber das Verschieben. Grundsätzlich funktioniert das Verschieben mit einem festen "Pfad" natürlich, aber dieser soll aus einer Textbox heraus genommen werden. Diese Textbox wird über einen Button 'Btn_OutlookZielOrdner_Click' mit der Auswahl des Outlook-Ordners gefüllt. So kann das Programm variable genutzt werden.
Nur hierbei habe ich im Netz leider keine Lösung gefunden, wie ich den Ordner ansprechen kann.
Kann mir von Euch jemand einen Tipp geben?
VB.NET-Quellcode
- Imports System.IO
- Imports Microsoft.Office.Interop
- Imports Microsoft.Office.Interop.Outlook
- Public Class Form1
- 'Dim objOL As New Outlook.Application
- 'Public colAtts As Outlook.Attachments
- 'Public sFile As String
- 'Public sFileType As String
- 'Public OutlookDateiname As String
- Public objWMI As Object
- Public ProcessList As Object
- Public Outlookschongestartet As Boolean
- ' Create Outlook application.
- Public oApp As Outlook.Application 'Microsoft.Office.Interop.Outlook.Application = New Microsoft.Office.Interop.Outlook.Application
- Private Sub PBox_DoppelteMailsFinden_Click(sender As Object, e As EventArgs) Handles PBox_DoppelteMailsFinden.Click
- ' Hier werden die aktuellen Mailinfos festgehalten
- Dim AktuelleMailInfos As String
- ' Hier werden die nächsten Mailinfos festgehalten
- Dim NaechstenMailInfos As String
- ' Hier werden die letzten Mailinfos festgehalten
- Dim LetzteMailInfos As String
- ' ******************************************************
- ' Outlook schön geöffnet?
- ' ******************************************************
- On Error Resume Next
- ' Alle Windows Prozesse aufrufen
- objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & "." & "\root\cimv2")
- ' und dann davon alle filtern, die in ihrem Namen Outlook.exe beinhalten
- ProcessList = objWMI.ExecQuery("Select * from Win32_Process " & "Where Name = 'OUTLOOK.EXE'")
- ' Wenn die Datensatzmenge = 0 ist, dann ist Outlook auch nicht gestartet
- If ProcessList.Count = 0 Then
- Outlookschongestartet = False
- Else
- ' andernfalls schon
- Outlookschongestartet = True
- 'For Each objProcess In ProcessList
- ' objProcess.Terminate 'Prozess beenden
- 'Next objProcess
- oApp = New Microsoft.Office.Interop.Outlook.Application ' GetObject(, "Outlook.Application")
- End If
- ' Wenn Outlook nicht gestartet wurde, dies jetzt nachholen
- If Outlookschongestartet = False Then
- oApp = New Microsoft.Office.Interop.Outlook.Application ' CreateObject("Outlook.Application")
- End If
- 'oApp = CreateObject("Outlook.Application")
- ' Get Mapi NameSpace.
- Dim oNS As Microsoft.Office.Interop.Outlook.NameSpace = oApp.GetNamespace("mapi") ' oNS.Logon( "Xyz_Configured_Outlook" , Missing.Value, False , True )
- ' Get Messages collection of Inbox.
- Dim oInbox As Microsoft.Office.Interop.Outlook.MAPIFolder = oNS.GetDefaultFolder(Microsoft.Office.Interop.Outlook.OlDefaultFolders.olFolderInbox)
- Dim overz As MAPIFolder
- 'overz = oNS.GetDefaultFolder(Microsoft.Office.Interop.Outlook.OlDefaultFolders.olFolderInbox)
- 'oInbox.Display()
- Dim oItems As Microsoft.Office.Interop.Outlook.Items = oInbox.Items
- 'Console.WriteLine("Total : " & oItems.Count)
- ' Get unread e-mail messages.
- ' oItems = oItems.Restrict("[unread] = false")
- oItems.Sort("[ReceivedTime]", True)
- 'Console.WriteLine("Total Unread : " & oItems.Count)
- ' Loop each unread message.
- Dim oMsg As Object
- Dim myDestFolder As Outlook.Folder
- Dim oulAusgewählte As Outlook.Selection
- Dim i As Integer
- Call Outlook_Orderpfad_Umschreiben()
- 'For i = 1 To oItems.Count - 1
- i = 1
- For Each It In oItems
- oMsg = oItems.Item(i)
- AktuelleMailInfos = oMsg.SenderName & " " & oMsg.Subject & " " & oMsg.ReceivedTime
- 'MsgBox(i & vbCrLf & oMsg.SenderName & vbCrLf & oMsg.Subject & vbCrLf & oMsg.ReceivedTime & vbCrLf & oMsg.Body & vbCrLf & "---------------------------" & vbCrLf & "press any key to continue")
- oMsg = oItems.Item(i + 1)
- NaechstenMailInfos = oMsg.SenderName & " " & oMsg.Subject & " " & oMsg.ReceivedTime
- If AktuelleMailInfos = NaechstenMailInfos Then
- ' Die Doppelten anzeigen
- If MsgBox("Doppelt: " & vbCrLf & vbCrLf & AktuelleMailInfos & vbCrLf & vbCrLf & NaechstenMailInfos & vbCrLf & vbCrLf & "Soll diese Mail nicht gelöscht werden, dann wählen Sie 'JA' aus, andernfalls wird diese Mail gelöscht", MsgBoxStyle.DefaultButton2 + MsgBoxStyle.YesNo + MsgBoxStyle.Question, "Doppelte e-Mail gefunden") = MsgBoxResult.No Then
- oItems.Item(i + 1).unread = True
- oApp.ActiveExplorer.AddToSelection(oItems.Item(i + 1))
- oulAusgewählte = oApp.ActiveExplorer.Selection
- End If
- End If
- If i <= oItems.Count - 2 Then
- i = i + 1
- Else
- Exit For
- End If
- Next
- ' Wenn es doppelte Mails gibt, diese nun verschieben
- If oulAusgewählte.Count > 0 Then
- For intZähler = 1 To oulAusgewählte.Count
- MsgBox(Outlook_Orderpfad_Umschreiben)
- oulAusgewählte.Item(intZähler).Move(oApp.Application.Session.Folders(Outlook_Orderpfad_Umschreiben)) ' "meinName@firma.de").Folders("Aktenschrank").Folders("Ablesekarten").Folders("Test"))
- Next intZähler
- MsgBox("Es wurden " & oulAusgewählte.Count - 1 & " doppelte Mails in den Ordner" & vbCrLf & vbCrLf & TBox_PDFPfad_Temp.Text & vbCrLf & vbCrLf & " als ungelesen verschoben.")
- Else
- MsgBox("Es gab im Ordner " & oInbox.Name & " keine doppelten Mails." & vbCrLf & vbCrLf & "Verglichen wurde Abseender, Betreffzeile und Datum/Uhrzeit.")
- End If
- End Sub
- Function Outlook_Orderpfad_Umschreiben() As String
- Dim Pfadteile() As String
- Dim NeuerPfad As String
- ' Ein paar unnötige Zeichen löschen
- TBox_PDFPfad_Temp.Text = Replace(TBox_PDFPfad_Temp.Text, "\\", "")
- Pfadteile = Split(TBox_PDFPfad_Temp.Text, "\")
- NeuerPfad = Chr(34) & Pfadteile(0) & Chr(34)
- For z = 1 To Pfadteile.Length - 1
- NeuerPfad = NeuerPfad & ").Folders(" & Chr(34) & Pfadteile(z) & Chr(34)
- Next
- NeuerPfad = NeuerPfad & ")"
- Return NeuerPfad
- End Function
- Private Sub Btn_OutlookZielOrdner_Click(sender As Object, e As EventArgs) Handles Btn_OutlookZielOrdner.Click
- TBox_PDFPfad_Temp.Text = Outlook_Ordner_auswaehlen()
- End Sub
- Function Outlook_Ordner_auswaehlen() As String
- ' Create Outlook application.
- Dim oApp As Microsoft.Office.Interop.Outlook.Application = New Microsoft.Office.Interop.Outlook.Application
- ' Get Mapi NameSpace.
- Dim oNS As Microsoft.Office.Interop.Outlook.NameSpace = oApp.GetNamespace("mapi")
- Dim oFolder As Microsoft.Office.Interop.Outlook.MAPIFolder
- Dim c As String
- oFolder = oNS.PickFolder
- Dim f As Int16
- For f = 1 To oFolder.Folders.Count
- c = oFolder.Folders.Item(f).FolderPath
- Next
- Return oFolder.FolderPath
- End Function
- End Class
Gruß
Volker
Dieser Beitrag wurde bereits 3 mal editiert, zuletzt von „Volker Bunge“ ()