Outlook - Makro na vytvorenie priečinkov

Problém

Dostávam e-maily veľmi často, ktoré majú v názve e-mailu "slovo" vo formáte issue-xxxx, kde xxxx je 4-miestne číslo. Vytvoril som priečinok s poštovými schránkami s názvom problémy. Čo by som rád, aby makro urobiť, je nájsť všetky e-maily s reťazcom formátu issue-xxxx v názve a pozrite sa na priečinok v otázkach s rovnakým názvom. Ak nie je nájdený, potom by mal byť vytvorený. E-mail by sa mal potom presunúť do tohto podpriečinka.

Predpokladajme napríklad, že e-mail prichádza so slovom issue-1234. Makro, keď je spustené (dúfajme, že na paneli s nástrojmi), by malo nájsť tento e-mail a skontrolovať priečinok s názvom issue-1234 v priečinku s otázkami a vytvoriť ho, ak sa nenašiel. E-mail by potom mal byť presunutý do tohto priečinka-1234.

V minulosti som neurobil žiadne makro programovanie, takže by som ocenil akúkoľvek pomoc, ako začať. Ak sa vám stalo, že máte makro, ktoré to už robí, a chcete zdieľať kód, bolo by to ešte lepšie.

Riešenie

'Súbor projektov vo vlastných podpriečinkoch

'Napísal Bryce Pepper ( )

'Vyhľadáva predmet pre číslo projektu M alebo Z (musí byť v rozsahu 4-6 číslic)

'a ukladá ich do podadresára projektu (ak neexistuje, vytvorte priečinok)

'pridaná podpora projektov P & R 2009-03-03 B.Pepper

'pridaná podpora pre # aby Bill Z. šťastný 2009-03-04 B.Pepper

Tu je kód:

 Dim WithEvents objInboxItems Ako Outlook.Items Dim objDestinationFolder Ako Outlook.MAPIFolder Sub Application_Startup () Dim objNameSpace Ako Outlook.NameSpace Dim objInboxFolder Ako Outlook.MAPIFolder Nastaviť objNameSpace = Application.Session Set objInboxFolder = objNameSpace.GetDefaultFolder (olFolderInbox) Nastaviť objInboxItems = objNameSpace.GetDefaultFolder (olFolderInbox) Set objInboxItems = objInboxFolder.Items Nastaviť objInboxItems = objInboxFolder.Items Set objDestinationFolder = objInboxFolder.Parent.Folders ("Projects") End Sub 'Spustite tento kód na zastavenie vášho pravidla. Sub StopRule () Nastaviť objInboxItems = Nothing End Sub 'Tento kód je skutočné pravidlo. Private Sub objInboxItems_ItemAdd (ByVal položka ako objekt) Dim objProjectFolder Ako Outlook.MAPIFolder Dim folderName Ako String Nastaviť objRegEx = CreateObject ("VBScript.RegExp") objRegEx.Global = False 'Hľadať e-mailové predmety, ktoré obsahujú číslo projektu (M007439, Z6312) objRegEx .Pattern = "([M, Z, P, R, #] d {4, 6})" Nastaviť colMatches = objRegEx.Execute (Item.Subject) Ak colMatches.Count> 0 Potom pre každý myMatch V colMatches If Left $ (myMatch.Value, 1) = "#" Potom folderName = "M" & Právo $ ("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) Potom nastavte objProjectFolder = objDestinationFolder.Folders (folderName) Else Set objProjectFolder = objDestinationFolder.Folders.Add (folderName) End If Item.Move objProjectFolder Nasledujúci Koniec Ak Nastaviť objProjectFolder = Nič End Sub Funkcia FolderExists (parentFolder As MAPIFolder, folderName As String) Dim tmpInbox Ako MAPIFolder On Error GoTo ha ndleError 'Ak priečinok neexistuje, bude v ďalšom riadku chyba. Táto chyba spôsobí, že obsluha chýb prejde na: handleError 'a preskočí hodnotu True return Set tmpInbox = parentFolder.Folders (folderName) FolderExists = True Exit Function handleError: FolderExists = Funkcia False End 

Poznač si to

Ďakujeme Pepperovi za tento tip na fóre.

Predchádzajúci Článok Nasledujúci Článok

Najlepšie Tipy