Outlook - Ein Makro zum Erstellen von Ordnern

Problem

Ich erhalte sehr häufig E-Mails mit einem "Wort" im Titel der E-Mail im Format "issue-xxxx", wobei xxxx eine vierstellige Zahl ist. Ich habe einen Postfachordner mit dem Namen "Issues" erstellt. Ich möchte, dass das Makro alle E-Mails mit einem String des Formats issue-xxxx im Titel findet und unter Issues mit demselben Namen nach einem Ordner sucht. Wenn einer nicht gefunden wird, sollte er erstellt werden. Die E-Mail sollte dann in diesen Unterordner verschoben werden.

Angenommen, eine E-Mail enthält das Wort issue-1234. Wenn das Makro ausgeführt wird (hoffentlich über die Symbolleiste), sollte es diese E-Mail finden und unter dem Issues-Ordner nach einem Ordner mit dem Namen issue-1234 suchen und ihn erstellen, falls er nicht gefunden wurde. Die E-Mail sollte dann in den Ordner issue-1234 verschoben werden.

Ich habe in der Vergangenheit noch keine Makroprogrammierung durchgeführt, daher wäre jede Hilfe beim Einstieg dankbar. Wenn Sie zufällig über ein Makro verfügen, das dies bereits ausführt, und den Code freigeben möchten, ist dies sogar noch besser.

Lösung

'Projekte in eigenen Unterordnern ablegen

'Geschrieben von Bryce Pepper ( )

'Sucht nach Betreff einer M- oder Z-Projektnummer (muss zwischen 4 und 6 Ziffern liegen)

'und legt sie in einem Projekt-Unterordner ab (Ordner erstellen, falls nicht vorhanden)

Unterstützung für P & R-Projekte hinzugefügt 2009-03-03 B.Pepper

Unterstützung für # hinzugefügt, um Bill Z. glücklich zu machen 2009-03-04 B.Pepper

Hier ist der Code:

 Dim WithEvents objInboxItems As Outlook.Items Dim objDestinationFolder As Outlook.MAPIFolder Sub Application_Startup () Dim objNameSpace As Outlook.NameSpace Dim objInboxFolder As Outlook.MAPIFolder Set objDestinationFolder = objInboxFolder.Parent.Folders ("Projects") End Sub 'Führen Sie diesen Code aus, um Ihre Regel zu stoppen. Sub StopRule () Set objInboxItems = Nothing End Sub 'Dieser Code ist die eigentliche Regel. Private Sub objInboxItems_ItemAdd (ByVal Item As Object) Dim objProjectFolder As Outlook.MAPIFolder Dim folderName As String Set .Pattern = "([M, Z, P, R, #] d {4, 6})" Set colMatches = objRegEx.Execute (Item.Subject) If colMatches.Count> 0 Then For Each myMatch In colMatches If Left $ (myMatch.Value, 1) = "#" Dann folderName = "M" & Right $ ("00" & Mid $ (myMatch.Value, 2), 6) Sonst folderName = Left $ (myMatch.Value, 1) & Right $ ("00" & Mid $ (myMatch.Value, 2), 6) End If If FolderExists (objDestinationFolder, folderName) Dann Set objProjectFolder = objDestinationFolder.Folders (folderName) Else Set objProjectFolder = objDestinationFolder.Folders.Add (folderName) End If Item.Move objProjectFolder Next End If Set objProjectFolder = Nothing End Sub Function FolderExists (übergeordneter Ordner als MAPIFolder, Ordnername als Zeichenfolge) Dim tmpInbox As MAPIFolder On Error GoTo ha ndleError 'Wenn der Ordner nicht existiert, wird in der nächsten Zeile ein Fehler angezeigt. Dieser Fehler führt dazu, dass die Fehlerbehandlungsroutine zu 'handleError' wechselt und den Rückgabewert True überspringt. Set tmpInbox = parentFolder.Folders (folderName) FolderExists = True Exit Function handleError: FolderExists = False End Function 

Beachten Sie, dass

Danke an Pepper für diesen Tipp im Forum.

Vorherige Artikel Nächster Artikel

Top-Tipps