Question

我希望有一个宏来搜索文件夹中的所有邮件，并在每封电子邮件中提取部分唯一的号码。例如，我有一封包含号码的电子邮件，987654321和另一封包含987542132的电子邮件，这两个号码都有前3个共同点，'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 As String，lead As String，numDigits As Integer）As String 昏暗的柜台As Long Dim test As String 昏暗的数字作为字符串对于counter = 1到numDigits - Len（4） digits = digits＆amp; “10” 下一个柜台对于counter = 1到Len（bodyText） - numDigits test = Mid（bodyText，counter，numDigits）如果测试像铅和＆amp;数字然后 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

在包含起始编号/特定接收日期的文件夹中搜索Outlook电子邮件

1 个答案: