Outlook - Een macro om mappen te maken

Kwestie

Ik ontvang vaak e-mails met een "woord" in de titel van de e-mail in het formaat van issue-xxxx, waarbij xxxx een 4-cijferig nummer is. Ik heb een mailboxmap gemaakt met de naam issues. Wat ik wil dat de macro doet, is alle e-mails met een reeks van de indeling issue-xxxx in de titel vinden en zoeken naar een map met problemen met diezelfde naam. Als er geen wordt gevonden, moet deze worden gemaakt. De e-mail moet dan worden verplaatst naar die submap.

Stel dat er een e-mail binnenkomt met het woord nummer-1234. Als de macro wordt uitgevoerd (hopelijk via de werkbalk), moet de macro die e-mail vinden en controleren op een map met de naam issue-1234 onder de map issues en deze maken als deze niet is gevonden. De e-mail moet dan worden verplaatst naar de map issue-1234.

Ik heb in het verleden niet echt macro-programmering gedaan, dus alle hulp bij het opstarten zou op prijs worden gesteld. Als je toevallig een macro hebt die dit al doet en de code wil delen, zou dat nog beter zijn.

Oplossing

'Bestandsprojecten in hun eigen submappen

'Geschreven door Bryce Pepper ( )

'Zoekopdrachten onderworpen aan een M- of Z-projectnummer (moet tussen 4-6 cijfers zijn)

en archiveert ze in een project-submap (maak een map aan als er geen bestaat)

'toegevoegde ondersteuning voor P & R-projecten 2009-03-03 B.Pepper

'ondersteuning toegevoegd voor # om Bill Z. gelukkig 2009-03-04 B.Pepper te maken

Hier is de code:

 Dim WithEvents objInboxItems Als Outlook.Items Dim objDestinationFolder Als Outlook.MAPIFolder Sub Application_Startup () Dim objNameSpace Als Outlook.NameSpace Dim objInboxFolder Als Outlook.MAPIFolder Set objNameSpace = Application.Session Set objInboxFolder = objNameSpace.GetDefaultFolder (olFolderInbox) Set objInboxItems = objInboxFolder.Items Set objDestinationFolder = objInboxFolder.Parent.Folders ("Projects") End Sub 'Voer deze code uit om uw regel te stoppen. Sub StopRule () Set objInboxItems = Nothing End Sub 'Deze code is de eigenlijke regel. Private Sub objInboxItems_ItemAdd (ByVal Item als object) Dim objProjectFolder als Outlook.MAPIFolder Dim mapName As String Set objRegEx = CreateObject ("VBScript.RegExp") objRegEx.Global = False 'Zoeken naar e-mailonderwerpen met projectnummer (M007439, Z6312) objRegEx .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) = "#" Vervolgens mapName = "M" & Right $ ("00" & Mid $ (myMatch.Value, 2), 6) Else folderName = Left $ (myMatch.Value, 1) & Right $ ("00" & Mid $ (myMatch.Value, 2), 6) End If If FolderExists (objDestinationFolder, folderName) Then 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 (parentFolder As MAPIFolder, folderName As String) Dim tmpInbox As MAPIFolder On Error GoTo ha ndleError 'Als de map niet bestaat, is er een fout in de volgende regel. Door die fout gaat de fout-handler naar: handleError 'en slaat de True Return-waarde over Set tmpInbox = parentFolder.Folders (folderName) FolderExists = True Exit Function handleFout: FolderExists = False End Function