Outlook通過收件箱掃描主題中的特定字符串

Question

我正在處理項目時，我需要一個Outlook宏，它將通過收件箱掃描帶有「參考號」的電子郵件主題領域。如果未檢測到電子郵件，則系統可以從Excel電子表格移至下一個參考。

如果檢測到電子郵件，它將被解壓縮爲「MSG」文件並將實際電子郵件移入子文件夾。到目前爲止，我有一個將電子郵件解壓縮爲「MSG」文件的代碼，但我無法在主題字段中找到它來標識特定字符串（參考號）。我從本網站獲得了下面的EXCEL宏代碼。

Sub Work_with_Outlook() 

Set outlookApp = CreateObject("Outlook.Application") 

Dim olNs As Outlook.NameSpace 
Dim Fldr As Outlook.MAPIFolder 
Dim olMail As Variant 
Dim sir() As String 

Set outlookApp = New Outlook.Application 
Set olNs = outlookApp.GetNamespace("MAPI") 
Set Fldr = olNs.GetDefaultFolder(olFolderInbox) 
Set myTasks = Fldr.Items 

Set olMail = myTasks.Find("[Subject] = ""Macro""") 
If Not (olMail Is Nothing) Then 
    olMail.Display 
End If 

End Sub       

Answer 1

嘗試以下代碼：

Sub SaveAttachments() 

    Dim myOlapp As Outlook.Application 
    Dim myNameSpace As Outlook.Namespace 
    Dim myFolder, destFolder As Outlook.MAPIFolder 
    Dim i, lr As Long 

    'last used row in excel 
    lr = Cells(Rows.Count, "A").End(xlUp).Row 

    Set myOlapp = GetObject(, "Outlook.application") 
    Set myNameSpace = myOlapp.GetNamespace("MAPI") 
    Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox) 
    Set destFolder = myFolder.Folders("provide subFolderName here") 
    Set mytask = myFolder.Items 

    'Download and move attachment if found 
    For i = 1 To lr 

     'The below line of code will not work if you are using wild card or partial string 
     Set ref = mytask.Find("[Subject] =" & Range("a" & i).Value) 
     If Not (ref Is Nothing) Then 
      ref.Attachments.Item(1).SaveAsFile "C:\" & Range("a" & i).Value & ".msg" 
      ref.Move destFolder 
     End If 
     Set ref = Nothing 

     'The workaround code goes as below 
     For Each myItem In mytask 
      If myItem.Class = olMail Then 
       If InStr(1, myItem.Subject, Range("a" & i).Value) > 0 Then 
        myItem.Attachments.Item(1).SaveAsFile "C:\" & Range("a" & i).Value & ".msg" 
        myItem.Move destFolder 
       End If 
      End If 
     Next myItem 

    Next i 

    Set myOlapp = Nothing 
    Set myNameSpace = Nothing 
    Set myFolder = Nothing 
    Set destFolder = Nothing 
    Set mytask = Nothing 

End Sub 

注意：假設的參考號是 「a」 列