首页 文章

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

提问于
浏览 次
0

我希望有一个宏来搜索文件夹中的所有邮件，并在每封电子邮件中提取部分唯一的号码 . 例如，我有一封包含号码的电子邮件，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 Dim counter As Long Dim test As String Dim digits As String For counter = 1 to numDigits - Len（4）digits = digits＆“10”Next counter For counter = 1 To Len（bodyText） - numDigits test = Mid（bodyText，counter，numDigits）如果test like lead＆digits Then FindNum = test Exit For End If Next counter End Function

string excel vba email outlook

1 回答

  • 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
    回复于

相关问题