Excel&Outlook_VBA_自動將符合條件的信件內文存到指定的excel檔案

 

成了。

「當Outlook收進了一封主旨含有特定關鍵字的信，即觸發VBA指令碼，自動將該信件內文中第二個表格的某幾個特定欄位之數字存到預先準備好的excel檔案中，並依時間記錄之。」
這麼明確的一件事情，很難嗎？
單就VBA的程式複雜度來說，不難。
但就學習的難易度來說，較普通的excel VBA難上許多許多。
較難的原因有二：
1.excel有錄製巨集的功能，再怎麼不會寫程式的人，都可以先把巨集錄起來，再慢慢觀看程式碼是怎麼寫的。
但是很可惜outlook沒有錄製巨集的功能。

2.網路上Outlook的VBA討論遠較excel的少上太多了。
如果Google搜尋「outlook vba」「excel vba」這兩組關鍵字，分別是946,000項結果和14,400,000項結果。相差超過15倍。

第一個因素使得自學的難度提升，
第二個因素使得找到人教的難度提升。
所以就是這麼一個簡單功能，逼得我問人又問人，搜尋又搜尋。

最後總算是實作出來了。

附上目前的程式碼，大家一起參詳參詳。

---

Sub ExportToExcel(MyMail As MailItem)

Dim srtID As String, oINS As Outlook.NameSpace
Dim olMail As Outlook.MailItem
Dim strFileName As String
Dim we

‘Excel Varibles
Dim oXLAPP As Object, oXLwb As Object
Dim lRow As Long

‘Set MyMail = ActiveExplorer.Selection.Item(1)

strID = MyMail.EntryID
Set olNS = Application.GetNamespace(“MAPI”)
Set olMail = olNS.GetItemFromID(strID)

‘Establish an Excel application object
On Error Resume Next
Set oXLAPP = GetObject(, “Excel.Applicaion”)

‘If not found then create new instance
If Err.Number <> 0 Then
Set oXLAPP = CreateObject(“Excel.Application”)
End If
Err.Clear
On Error GoTo 0

””
Set myinspector = MyMail.GetInspector
Set we = myinspector.WordEditor
Set tbl = we.tables(2)

‘Show Excel
oXLAPP.Visible = True

‘Open the relevant file
Set oXLwb = oXLAPP.Workbooks.Open(“C:mailtoexcel.xlsx”)

‘Set the relevant output sheet. Change as applicable
On Error Resume Next
If olMail.Body Like “*關鍵字*” Then

With oXLwb.sheets(1)
For c = 1 To 10
For r = 1 To 12
.cells(r, c) = tbl.cell(r, c)
Next
Next

End With
End If

lastrow = oXLwb.sheets(“record”).[A1].End(xlDown).Row
oXLwb.sheets(“record”).cells(lastrow + 1, 1).Value = Year(Now()) & “/” & Month(Now()) & “/” & Day(Now())
oXLwb.sheets(“record”).cells(lastrow + 1, 2).Value = oXLwb.sheets(1).cells(9, 4)
oXLwb.sheets(“record”).cells(lastrow + 1, 3).Value = oXLwb.sheets(1).cells(10, 4)
oXLwb.sheets(“record”).cells(lastrow + 1, 4).Value = oXLwb.sheets(1).cells(11, 4)
oXLwb.sheets(“record”).cells(lastrow + 1, 5).Value = oXLwb.sheets(1).cells(12, 4)

‘Close and Clean up EXCEL
oXLwb.Save
oXLwb.Close (True)
oXLAPP.Quit
Set oXLwb = Nothing
Set oXLAPP = Nothing

Set olMail = Nothing
Set olNS = Nothing
End Sub

---