Outlook - makro mapju izveidei

Izdevums

Es bieži saņemu e-pasta vēstules, kurām e-pasta nosaukumā ir vārds "xxxx", kur xxxx ir 4 ciparu numurs. Esmu izveidojis pastkastes mapi ar problēmām. Ko es gribētu, lai makro darītu, ir atrast visus e-pastus ar formāta jautājumu virkni-xxxx nosaukumā un meklēt mapi ar tādiem pašiem nosaukumiem. Ja viens netiek atrasts, tas ir jāizveido. Pēc tam e-pasts jāpārvieto uz šo apakšmapi.

Piemēram, pieņemsim, ka e-pasta ziņojumā ir iekļauts vārds-1234. Makro, palaižot (cerams, izmantojot rīkjoslu), atradīs šo e-pasta ziņojumu un pārbauda, vai mapē, ko sauc par problēmu, mapē izsaukums-1234, un izveidojiet to, ja tas netika atrasts. Pēc tam e-pasts jāpārvieto uz šo jautājumu-1234 mapi.

Es neesmu patiešām paveicis makro programmēšanu pagātnē, tāpēc jebkāda palīdzība par to, kā sākt darbu, būtu novērtēta. Ja jums ir makro, kas to dara jau tagad, un vēlaties koplietot kodu, tas būtu vēl labāk.

Risinājums

'Failu projekti savās apakšmapes

"Rakstīja Bryce Pepper ( )

'M un Z projekta numuru meklējumi (jābūt no 4 līdz 6 cipariem)

"un tos ievieto projekta apakšmapes (izveidojiet mapi, ja tāda nav)

“Papildu atbalsts P & R projektiem 2009-03-03 B.Pepper

"Pievienots atbalsts #, lai padarītu Bill Z. laimīgu 2009-03-04 B.Pepper

Šeit ir kods:

 Dim WithEvents objInboxItems As Outlook.Items Dim objDestinationFolder kā Outlook.MAPIFolder Sub Application_Startup () Dim objNameSpace kā Outlook.NameSpace Dim objInboxFolder Kā Outlook.MAPIFolder Set objNameSpace = Application.Session Set objInboxFolder = objNameSpace.GetDefaultFolder (olFolderInbox) Iestatīt objInboxItems = objInbox Iestatīt objDestinationFolder = objInboxFolder.Parent.Folders ("Projekti") Beigt Sub 'Izpildiet šo kodu, lai apturētu savu noteikumu. Sub StopRule () Iestatīt objInboxItems = Nekas Beigas Sub 'Šis kods ir faktiskais noteikums. Privāts sub objInboxItems_ItemPievienot (ByVal postenis kā objekts) Dim objProjectFolder Kā Outlook.MAPIFolder Dim mapeNe kā String Set objRegEx = CreateObject ("VBScript.RegExp") objRegEx.Global = Nepareizi 'Meklēt e-pasta objektus, kuros ir projekta numurs (M007439, Z6312) objRegEx .Pattern = "([M, Z, P, R, #] d {4, 6})" Set colMatches = objRegEx.Execute (Item.Subject) Ja colMatches.Count> 0 Tad katram MyMatch In ColMatches Ja kreisie $ (myMatch.Value, 1) = "#" Tad folderName = "M" un labais $ ("00" & Mid $ (myMatch.Value, 2), 6) Else folderName = Left $ (myMatch.Value, 1) & Labais $ ("00" & Mid $ (myMatch.Value, 2), 6) Beigas Ja Ja mapeExists (objDestinationFolder, folderName) Tad iestatiet objProjectFolder = objDestinationFolder.Folders (folderName) Else Set objProjectFolder = objDestinationFolder.Folders.Add (folderName) Beigas Ja vienums.Pāriet objProjectFolder Nākamais beigas Ja iestatījums objProjectFolder = Nekas Beigas apakšfunkcija FolderExists (mātes mape kā MAPIFolder, folderName kā virkne) Dim tmpInbox Kā MAPIFolder kļūdā GoTo ha ndleError 'Ja mape nepastāv, nākamajā rindā būs kļūda. Šī kļūda radīs kļūdas apstrādātāju, lai pārietu uz: handleError 'un izlaist True return vērtību Iestatīt tmpInbox = parentFolder.Folders (mapeName) FolderExists = True Exit Funkcija handError: FolderExists = False End Function