从Outlook中提取电子邮件地址 [英] extract email address from outlook

问题描述

我正在尝试提取Outlook收件箱中所有电子邮件的电子邮件地址.我在互联网上找到了此代码.

I am trying to extract email addresses of all emails in my Outlook inbox. I found this code on the Internet.

Sub GetALLEmailAddresses()

Dim objFolder As MAPIFolder
Dim strEmail As String
Dim strEmails As String
''' Requires reference to Microsoft Scripting Runtime
Dim dic As New Dictionary
Dim objItem As Object

''Set objFolder = Application.ActiveExplorer.Selection
Set objFolder = Application.GetNamespace("Mapi").PickFolder

For Each objItem In objFolder.Items

   If objItem.Class = olMail Then

       strEmail = objItem.SenderEmailAddress

       If Not dic.Exists(strEmail) Then

           strEmails = strEmails + strEmail + vbCrLf

           dic.Add strEmail, ""

       End If

我正在使用Outlook2007.当我使用F5从Outlook Visual Basic编辑器运行此代码时，在下一行出现错误.

I am using outlook 2007. When I run this code from the Outlook Visual Basic Editor with F5 I get an error on the following line.

Dim dic As New Dictionary

"user defined type not defined"

推荐答案

我在下面提供了更新的代码

I have provided updated code below

1. 将收件箱电子邮件地址转储到CSV文件" c:\ emails.csv "(当前代码未为收集的地址提供外观"
2. 上面的代码根据您的请求在选定的文件夹上起作用，而不是在收件箱"上起作用

1. to dump the Inbox email addresses to a CSV file "c:\emails.csv" (the current code provides no "outlook" for the collected addresses
2. the code above works on a selected folder rather than Inbox as per your request

[更新:为清楚起见，这是您使用早期绑定"的旧代码，对于下面使用后期绑定"的更新代码，无需设置此引用]

A部分:您现有的代码(早期绑定)

关于您收到的错误:

上面的代码示例使用早期绑定，该注释需要对Microsoft脚本运行时的引用" 表明需要设置引用

The code sample aboves uses early binding, this comment "Requires reference to Microsoft Scripting Runtime" indciates that you need to set the reference

• 转到工具"菜单
• 选择参考"
• 检查"Microdoft脚本运行时"

B部分:我的新代码(后期绑定-无需设置引用)

工作代码

Sub GetALLEmailAddresses() 
Dim objFolder As MAPIFolder
Dim strEmail As String
Dim strEmails As String
Dim objDic As Object
Dim objItem As Object
Dim objFSO As Object
Dim objTF As Object

Set objDic = CreateObject("scripting.dictionary")
Set objFSO = CreateObject("scripting.filesystemobject")
Set objTF = objFSO.createtextfile("C:\emails.csv", 2)
Set objFolder = Application.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox)
For Each objItem In objFolder.Items
    If objItem.Class = olMail Then
        strEmail = objItem.SenderEmailAddress
        If Not objDic.Exists(strEmail) Then
            objTF.writeline strEmail
            objDic.Add strEmail, ""
        End If
    End If
Next
objTF.Close
End Sub

这篇关于从Outlook中提取电子邮件地址的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！