Outlook - Ett makro för att skapa mappar

Problem

Jag mottar mycket ofta e-postmeddelanden som har ett "ord" i titeln på e-postmeddelandet i formatet issue-xxxx, där xxxx är ett fyrsiffrig nummer. Jag har skapat en brevlåda mapp som heter problem. Vad jag vill att makroen ska göra är att hitta alla e-postmeddelanden med en sträng av formatproblemet xxxx i titeln och leta efter en mapp under problem med samma namn. Om man inte hittas ska den skapas. E-postmeddelandet ska sedan flyttas till den undermappen.

Antag förmodligen att ett email kommer in med ordet-1234. Makroet, när det körs (förhoppningsvis via verktygsfältet), ska hitta det e-postmeddelandet och kolla efter en mapp som heter problem-1234 under problemmappen och skapa den om den inte hittades. E-postmeddelandet ska då flyttas till den aktuella mappen 1234.

Jag har inte gjort någon makroprogrammering tidigare, så någon hjälp om hur man kommer igång skulle uppskattas. Om du råkar ha ett makro som gör det redan, och vill dela koden, skulle det bli ännu bättre.

Lösning

"Filprojekt i sina egna undermappar

"Skrivet av Bryce Pepper ( )

'Sökningar som omfattas av ett M- eller Z-projektnummer (måste vara mellan 4-6 siffror)

'och lägger dem i en projektmapp (skapa mapp om ingen existerar)

"lagt till stöd för P & R-projekt 2009-03-03 B.Pepper

"lagt till stöd för # för att göra Bill Z. happy 2009-03-04 B.Pepper

Här är koden:

 Dim withEvents objInboxItems As Outlook.Items Dim objDestinationFolder Som Outlook.MAPIFolder Sub Application_Startup () Dim objNameSpace Som Outlook.NameSpace Dim objInboxFolder Som Outlook.MAPIFolder Ställ objNameSpace = Application.Session Ställ objInboxFolder = objNameSpace.GetDefaultFolder (olFolderInbox) Ställ objInboxItems = objInboxFolder.Items Ange objDestinationFolder = objInboxFolder.Parent.Folders ("Projects") End Sub "Kör den här koden för att stoppa din regel. Sub StopRule () Ange objInboxItems = Inget Slut Del "Den här koden är den faktiska regeln. Private Sub objInboxItems_ItemAdd (ByVal Item As Object) Dim objProjectFolder Som Outlook.MAPIFolder Dimma mappnamn Som stränguppsättning objRegEx = CreateObject ("VBScript.RegExp") objRegEx.Global = False 'Sök efter e-postämnen som innehåller projektnummer (M007439, Z6312) objRegEx .Pattern = "([M, Z, P, R, #] d {4, 6})" Ange colMatches = objRegEx.Execute (Item.Subject) Om colMatches.Count> 0 Då För varje myMatch I colMatches Om vänster $ (myMatch.Value, 1) = "#" Då mappnamn = "M" & Höger $ ("00" & Mid $ (myMatch.Value, 2), 6) Else folderName = Vänster $ (myMatch.Value, 1) Höger $ ("00" & Mid $ (myMatch.Value, 2), 6) Avsluta Om Om FolderExists (objDestinationFolder, mappnamn) Sätt sedan objProjectFolder = objDestinationFolder.Folders (mappnamn) Else Set objProjectFolder = objDestinationFolder.Folders.Add Avsluta om Item.Move objProjectFolder Next End Om Set objProjectFolder = Inget Slut Del Funktion FolderExists (parentFolder Som MAPIFolder, mappnamn Som String) Dim tmpInbox Som MAPIFolder On Error GoTo ha ndleError 'Om mappen inte existerar kommer det att finnas ett fel i nästa rad. Det felet kommer att få felhanteraren att gå till: handleError 'och hoppa över det sanna returvärdet Ange tmpInbox = parentFolder.Folders (mappnamn) FolderExists = True Exit Function handleError: FolderExists = False End Function