Outlook - kaustade loomiseks mõeldud makro

Probleem

Ma saan väga tihti e-kirju, millel on e-kirja pealkirjas väljaanne „xxxx” vormingus sõna „xxx”, kus xxxx on neljakohaline number. Olen loonud postkasti kausta nimega probleemid. Ma tahaksin, et makro oleks otsinud kõik e-kirjad, millel on pealkirjas vormingu väljaande-xxxx jada ja otsige kaust sama nime all olevates küsimustes. Kui seda ei leita, tuleks see luua. E-post tuleks seejärel viia sellesse alamkausta.

Oletame näiteks, et e-kirjaga kaasneb sõna-1234. Makro, kui see käivitatakse (loodetavasti tööriistariba kaudu), peaks leidma selle e-kirja ja kontrollima kausta, mida nimetatakse numbriks-1234 probleemide kausta all ja looge see, kui seda ei leitud. Seejärel tuleb e-kiri paigutada kausta 1234.

Ma ei ole minevikus makromajanduslikku programmi teinud, nii et igasugune abi alustamise kohta oleks teretulnud. Kui teil oleks makro, mis seda juba teeb ja soovite koodi jagada, oleks see veelgi parem.

Lahendus

'Failide projektid oma alamkaustades

"Kirjutas Bryce Pepper ( )

„M või Z projekti numbri otsingud (peavad olema 4-6 numbrit)

'ja failid need projekti alamkausta (luua kaust, kui seda pole)

„P & R projektide täiendav toetus 2009-03-03 B.Pepper

"Lisas toetust # -le, et teha Bill Z. õnnelikuks 2009-03-04 B.Pepper

Siin on kood:

 Dim WithEvents objInboxItems as Outlook.Items Dim objDestinationFolder nagu Outlook.MAPIFolder Sub Application_Startup () Dim objNameSpace kui Outlook.NameSpace Dim objInboxFolder Outlookis. Määra objDestinationFolder = objInboxFolder.Parent.Folders ("Projektid") Lõpeta alam. Sub StopRule () Set objInboxItems = Mitte midagi End Sub 'See kood on tegelik reegel. Privaatne sub objInboxItems_ItemLisa (ByVal üksus objektina) Dim objProjectFolder nagu Outlook.MAPIFolder Dim kataloogi nimi stringikomplektina objRegEx = CreateObject ("VBScript.RegExp") objRegEx.Global = False 'Otsi e-posti teemasid, mis sisaldavad projekti numbrit (M007439, Z6312) objRegEx .Pattern = "([M, Z, P, R, #] d {4, 6})" Määra colMatches = objRegEx.Execute (Item.Subject) Kui colMatches.Count> 0 Seejärel iga myMatch jaoks ColMatches Kui vasak $ $ (myMatch.Value, 1) = "#" Siis folderName = "M" ja parempoolne $ ("00" & Mid $ (myMatch.Value, 2), 6) Else folderName = Left $ (myMatch.Value, 1) & Parem $ ("00" & Mid $ (myMatch.Value, 2), 6) Lõpeta, kui FolderExists (objDestinationFolder, folderName) Seejärel seadke objProjectFolder = objDestinationFolder.Folders (folderName) Else Set objProjectFolder = objDestinationFolder.Folders.Add (folderName) Lõpeta üksus.Move objProjectFolder Järgmine lõpp Kui Set objProjectFolder = Mitte midagi lõpp-allfunktsiooni FolderExists (lähtefail kui MAPIFolder, kaustNimi kui stringina) Dim tmpInbox kui MAPIFolder On Error GoTo ha ndleError 'Kui kaust ei eksisteeri, tekib järgmises reas viga. See viga põhjustab veajuhtijale käsu: handleError 'ja jätke True Return väärtuse vahelejätmine Set tmpInbox = parentFolder.Folders (folderName) FolderExists = True Exit Funktsioon käepideError: FolderExists = False End Function