在包含起始號碼/特定收到日期的文件夾中搜索Outlook電子郵件

Question

我期待有一個宏將搜索文件夾中的所有郵件，並在每封電子郵件中提取部分唯一的號碼。例如，我有一封電子郵件，其中包含一個號碼987654321，另一封電子郵件中包含987542132這兩個號碼都有前三個共同的號碼'987'。我怎麼寫，所以它會搜索槽並從消息中提取所有這些數字，但不是整個消息？如果我可以在特定的日期範圍內放置收到郵件的地方，那也不錯。

這裏是我有的當前代碼，當我在outlook中選擇一個文件夾時，它將提取該文件夾中的所有消息並導出到電子表格中，包括主題，收到的時間和正文。我只是想要那些具體的數字！

Sub ExportMessagesToExcel() 
    Dim olkMsg As Object, _ 
     excApp As Object, _ 
     excWkb As Object, _ 
     excWks As Object, _ 
     intRow As Integer, _ 
     intVersion As Integer, _ 
     strFilename As String 
     strFilename = InputBox("Enter a filename and path to save the messages to.", "Export Messages to Excel") 
    If strFilename <> "" Then 
     intVersion = GetOutlookVersion() 
     Set excApp = CreateObject("Excel.Application") 
     Set excWkb = excApp.Workbooks.Add() 
     Set excWks = excWkb.ActiveSheet 
     'Write Excel Column Headers 
     With excWks 
      .Cells(1, 1) = "Subject" 
      .Cells(1, 2) = "Received" 
      .Cells(1, 3) = "Body" 
     End With 
     intRow = 2 
     'Write messages to spreadsheet 
     For Each olkMsg In Application.ActiveExplorer.CurrentFolder.Items 
      'Only export messages, not receipts or appointment requests, etc. 
      If olkMsg.Class = olMail Then 
       'Add a row for each field in the message you want to export 
       excWks.Cells(intRow, 1) = olkMsg.Subject 
       excWks.Cells(intRow, 2) = olkMsg.ReceivedTime 
       excWks.Cells(intRow, 3) = FindNum(olkMsg.Body, "2014", 14)     intRow = intRow + 1 
      End If 
     Next 
     Set olkMsg = Nothing 
     excWkb.SaveAs strFilename 
     excWkb.Close 
    End If 
    Set excWks = Nothing 
    Set excWkb = Nothing 
    Set excApp = Nothing 
    MsgBox "Completed. A total of " & intRow - 2 & " messages were exported.", vbInformation + vbOKOnly, "Export messages to Excel" 
End Sub 

Function GetOutlookVersion() As Integer 
    Dim arrVer As Variant 
    arrVer = Split(Outlook.Version, ".") 
    GetOutlookVersion = arrVer(0) 
End Function 

功能FindNum（bodyText的作爲字符串，鉛作爲字符串，numDigits作爲整數）作爲字符串 昏暗計數器只要 昏暗測試作爲字符串 昏暗位數作爲字符串 對於計數器= 1到numDigits - LEN（4 ） 位數=位數& 「10」 接着計數器 對於計數器= 1到LEN（bodyText的） - numDigits 測試=中（bodyText的，計數器，numDigits） 如果測試像鉛&位數然後 FindNum =測試 退出對於 結束如果 接下來計數器 端功能

Answer 1

這將找到並返回與您從一個更長的字符串指定鉛指定長度的數字只有字符的字符串。把它看作是一個InStr，它使用通配符來只返回一個數字值。我曾經爲一個項目做過這樣的事情。

Function FindNum(bodyText As String, lead As String, numDigits As Integer) As String 
Dim counter As Long 
Dim test As String 
Dim digits As String 
For counter = 1 To numDigits - Len(lead) 
    digits = digits & "#" 
Next counter 
For counter = 1 To Len(bodyText) - numDigits 
    test = Mid(bodyText, counter, numDigits) 
    If test Like lead & digits Then 
     FindNum = test 
     Exit For 
    End If 
Next counter 
End Function