Outlook - kansioiden luomiseen tarkoitettu makro

Ongelma

Vastaanotan sähköposteja hyvin usein, sillä niissä on sähköpostiosoitteen "sana" numeron xxxx muodossa, jossa xxxx on nelinumeroinen luku. Olen luonut postilaatikon kansion nimeltä ongelmat. Haluaisin, että makro tekisi kaikki sähköpostit, joissa on otsikkorivin merkkijono-xxxx, ja etsiä kansiota samanlaisissa ongelmissa. Jos sellaista ei löydy, se on luotava. Sähköpostin pitäisi sitten siirtää kyseiseen alikansioon.

Oletetaan esimerkiksi, että sähköpostiviestissä on sana numero-1234. Makro, kun se suoritetaan (toivottavasti työkalurivin kautta), pitäisi löytää tämän sähköpostin ja tarkistaa, että kansio nimeltä 1234 on ongelmakansiossa ja luo se, jos sitä ei löydy. Sähköpostin pitäisi sitten siirtää kyseiseen numeroon-1234-kansioon.

En ole oikeastaan tehnyt mitään makro-ohjelmia aikaisemmin, joten apua alkuun pääsemiseksi olisi arvostettu. Jos sinulla on makro, joka tekee tämän jo ja haluat jakaa koodin, se olisi vieläkin parempi.

Ratkaisu

'Tiedostot projektit omiin alikansioihinsa

"Kirjoittanut Bryce Pepper ( )

'Etsii aiheena M- tai Z-projektin numeron (on oltava 4-6 numeroa)

'ja tallentaa ne projektin alikansioon (luo kansio, jos sellaista ei ole)

Lisätuki P & R-hankkeille 2009-03-03 B.Pepper

"Lisätty tuki #: lle, jotta Bill Z. onnellinen 2009-03-04 B.Pepper

Tässä on koodi:

 Dim WithEvents objInboxItems Kuten Outlook.Items Dim objDestinationFolder Outlook.MAPIFolder Sub Application_Startup () Dim objNameSpace Outlook.NameSpace Dim objInboxFolder Outlookissa. Aseta objDestinationFolder = objInboxFolder.Parent.Folders ("Projektit") End Sub 'Suorita tämä koodi lopettaaksesi sääntösi. Sub StopRule () Aseta objInboxItems = Nothing End Sub 'Tämä koodi on todellinen sääntö. Yksityinen Sub objInboxItems_ItemLisää (ByVal-kohde objektina) Dim objProjectFolder Outlook.MAPIFolder Dim-kansioNimi merkkijonona objRegEx = CreateObject ("VBScript.RegExp") objRegEx.Global = False 'Etsi sähköpostin aiheita, jotka sisältävät projektinumeron (M007439, Z6312) objRegEx .Pattern = "([M, Z, P, R, #] d {4, 6})" Aseta colMatches = objRegEx.Execute (Item.Subject) Jos colMatches.Count> 0 Sitten jokaiselle myMatchille ColMatches Jos vasen $ (myMatch.Value, 1) = "#" Sitten folderName = "M" ja oikea $ ("00" & Mid $ (myMatch.Value, 2), 6) Else folderName = Vasen $ (myMatch.Value, 1) & Oikea $ ("00" & Mid $ (myMatch.Value, 2), 6) Lopeta Jos If FolderExists (objDestinationFolder, folderName) Sitten aseta objProjectFolder = objDestinationFolder.Folders (folderName) Else Set objProjectFolder = objDestinationFolder.Folders.Add (folderName) Lopeta, jos kohde. Siirrä objProjectFolder Seuraava loppu Jos asetus objProjectFolder = Ei mitään lopetusalatoimintoa FolderExists (vanhemman kansion nimellä MAPIFolder, kansioNimi merkkijonona) Dim tmpInbox MAPIFolderissä ndleError 'Jos kansiota ei ole, seuraavassa rivissä on virhe. Tämä virhe aiheuttaa virheenkäsittelijän menemisen kohteeseen: handleError 'ja ohita True Return -arvo Set tmpInbox = parentFolder.Folders (folderName) FolderExists = True Exit Function handleError: FolderExists = False End Function