Question

我有一个带有已保存邮件的Outlook文件夹，每个邮件都包含一个代码列表。我希望能够搜索自动收报机并获取包含该特定自动收报机的最新邮件的日期。我确实尝试在线搜索解决方案，例如Excel VBA for searching in mails of Outlook，但我找不到符合我需求的解决方案。

Answer 1

尝试我为您编写的此用户定义函数。将此代码添加到excel中的模块，然后将其用作Excel中的普通函数。您可以在文本引号中直接将函数名称输入到函数中，例如= FindTicker（“ABC”），或者您可以引用具有股票价值的另一个单元格，例如FindTicker（A1）

我假设您已将电子邮件保存到收件箱的子文件夹中。在代码中，将“子文件夹名称”替换为子文件夹的名称（仍为双引号）。如果尚未从收件箱中移动电子邮件，请完全删除该行。

要使其正常工作，您需要添加对Microsoft Outlook参考库的引用。

此功能仅在您添加代码的工作簿中运行，除非您将工作簿保存为加载项然后安装它，在这种情况下，该功能将在任何工作簿中可用。

Public Function FindTicker(strTicker As String) As Variant

Dim olApp As Outlook.Application
Dim olNamespace As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim olFolderItems As Outlook.Items
Dim olMail As Outlook.MailItem

'Open outlook if it's not open, otherwise connect to open instance
If Outlook.Application.Explorers.Count = 0 Then
    Set olApp = CreateObject("Outlook.Application")
Else
    Set olApp = Outlook.Application
End If

'Get emails to search through
Set olNamespace = olApp.GetNamespace("MAPI")
Set olFolder = olNamespace.GetDefaultFolder(olFolderInbox)
Set olFolder = olFolder.Folders("Subfolder name") 'UPDATE/REMOVE THIS LINE
Set olFolderItems = olFolder.Items

'Set default value if not found
FindTicker = "Ticker not found"

'Search through bodies of emails for ticker value
For Each olMail In olFolderItems
    If (InStr(1, olMail.Body, strTicker, vbTextCompare) > 0) Then
        FindTicker = Format(olMail.SentOn, "dd/mm/yyyy")
        Exit For
    End If
Next

'Clear object variables
Set olApp = Nothing
Set olNamespace = Nothing
Set olFolder = Nothing
Set olFolderItems = Nothing
Set olMail = Nothing

End Function

从Excel搜索特定的Outlook文件夹并检索最近匹配的日期

1 个答案: