Outlook - แมโครเพื่อสร้างโฟลเดอร์

ปัญหา

ฉันได้รับอีเมลบ่อยมากซึ่งมีคำว่า "word" อยู่ในหัวเรื่องของอีเมลในรูปแบบของปัญหา -xx โดยที่ xxxx เป็นตัวเลข 4 หลัก ฉันสร้างโฟลเดอร์กล่องจดหมายที่เรียกว่าปัญหา สิ่งที่ฉันต้องการให้แมโครทำคือค้นหาอีเมลทั้งหมดที่มีสตริงของปัญหา format-xxxx ในชื่อเรื่องและค้นหาโฟลเดอร์ภายใต้ปัญหาที่มีชื่อเดียวกัน หากไม่พบก็ควรจะสร้างขึ้น ควรย้ายอีเมลไปยังโฟลเดอร์ย่อยนั้น

ตัวอย่างเช่นสมมติว่าอีเมลเข้ามาพร้อมกับคำว่าปัญหา 1234 มาโครเมื่อทำงาน (หวังว่าผ่านแถบเครื่องมือ) ควรค้นหาอีเมลนั้นและตรวจสอบโฟลเดอร์ที่ชื่อว่าปัญหา -1234 ภายใต้โฟลเดอร์ปัญหาและสร้างหากไม่พบ ควรย้ายอีเมลไปยังโฟลเดอร์ฉบับที่ 1234

ฉันไม่ได้ทำการเขียนโปรแกรมแมโครมาก่อนในอดีตดังนั้นความช่วยเหลือใด ๆ เกี่ยวกับวิธีการเริ่มต้นจะได้รับการชื่นชม หากคุณมีมาโครที่ทำสิ่งนี้อยู่แล้วและต้องการแชร์รหัสนั่นจะดียิ่งขึ้น

สารละลาย

'ยื่นโครงการในโฟลเดอร์ย่อยของตนเอง

'เขียนโดย Bryce Pepper ( )

ค้นหาหัวเรื่องสำหรับหมายเลขโครงการ M หรือ Z (ต้องอยู่ระหว่าง 4-6 หลัก)

'และไฟล์เหล่านั้นในโฟลเดอร์ย่อยของโครงการ (สร้างโฟลเดอร์หากไม่มีอยู่)

'เพิ่มการสนับสนุนสำหรับโครงการ P & R 2009-03-03 B.Pepper

'เพิ่มการสนับสนุนสำหรับ # เพื่อทำให้ Bill Z. มีความสุข 2009-03-04 B.Pepper

นี่คือรหัส:

 Dim WithEvents objInboxItems เป็น Outlook.Items Dim objDestinationFolder เป็น Outlook.MAPIFolder Sub Application_StartupInterbox () Dim สลัว ObjNameSpace เป็น Outlook.NameSpace สลัว objInboxFolder เป็น Outlook.MAPIFolder Set objInspace ตั้งค่า objDestinationFolder = objInboxFolder.Parent.Folders ("โครงการ") สิ้นสุดการย่อย 'เรียกใช้รหัสนี้เพื่อหยุดกฎของคุณ Sub StopRule () ตั้งค่า objInboxItems = ย่อยไม่สิ้นสุด 'รหัสนี้เป็นกฎจริง Private Sub objInboxItems_ItemAdd (รายการ ByVal เป็นวัตถุ) Dim objProjectFolder เป็น Outlook.MAPIFolder Dim folderName Dim เป็นชุดสตริง objRegEx = CreateObject ("VBScript.RegExp") objRegEx.Global = False 'ค้นหาหัวข้อวิชาอีเมลที่มีหมายเลขโครงการ (M007FrameDomainName M007) .Pattern = "([M, Z, P, R, #] d {4, 6})" ตั้งค่า colMatches = objRegEx.Execute (Item.Subject) ถ้า colMatches.Count> 0 จากนั้นสำหรับแต่ละ myMatch ใน colMatches ถ้าปล่อยไว้ $ (myMatch.Value, 1) = "#" จากนั้น folderName = "M" & ขวา $ ("00" & กลาง $ (myMatch.Value, 2), 6) อื่น ๆ folderName = Left $ (myMatch.Value, 1) & ขวา $ ("00" & Mid $ (myMatch.Value, 2), 6) สิ้นสุดถ้าหาก FolderExists (objDestinationFolder, folderName) จากนั้นตั้งค่า objProjectFolder = objDestinationFolder.Folders (folderName) Else Set objProjectFolder สิ้นสุดถ้า Item.Move objProjectFolder ถัดไปท้ายถ้า Set objProjectFolder = ไม่มีอะไรสิ้นสุดฟังก์ชั่นย่อย FolderExists (parentFolder เป็น MAPIFolder, folderName As String) สลัว tmpInbox เป็น MAPIFolder ผิดพลาดไป ndleError 'หากโฟลเดอร์ไม่มีอยู่จะมีข้อผิดพลาดในบรรทัดถัดไป' ข้อผิดพลาดนั้นจะทำให้ตัวจัดการข้อผิดพลาดไปที่: handleError 'และข้ามค่าส่งคืน True ตั้งค่า tmpInbox = parentFolder.Folders (folderName) FolderExists = ฟังก์ชั่น Exit True handleError: FolderExists = ฟังก์ชั่น End เท็จ