outlook 2003获取所有“发件人”和“收件人”电子邮件地址

时间:2014-02-12 11:23:21

标签: vba outlook outlook-vba outlook-2003

我尝试使用此vba从Outlook 2003文件夹中的电子邮件中获取所有发件人和收件人电子邮件地址

Sub GetALLEmailAddresses()

Dim objFolder As Folder
Set objFolder = Application.ActiveExplorer.Selection

Dim dic As Dictionary
Dim strEmail As String
Dim strEmails As String

Dim objItem As MailItem
For Each objItem In objFolder.Items

    strEmail = objItem.SenderEmailAddress
'If Not dic.Exists(strEmail) Then
'strEmails = strEmails + strEmail + ";"
'dic.Add strEmail, ""
'End If

Next

Debug.Print strEmails
End Sub

知道我做错了什么?

2 个答案:

答案 0 :(得分:0)

这是To值

的工作示例
Sub ExtractEmail()
Dim OlApp As Outlook.Application
Dim Mailobject As Object
Dim Email As String
Dim NS As NameSpace
Dim Folder As MAPIFolder
Set OlApp = CreateObject("Outlook.Application")
' Setup Namespace
Set NS = ThisOutlookSession.Session
' Display select folder dialog
Set Folder = NS.PickFolder
' Create Text File
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("c:\email addresses.txt", True)
' loop to read email address from mail items.


Dim dic
Set dic = CreateObject("Scripting.Dictionary")
Dim strEmails As String

For Each Mailobject In Folder.Items
   Email = Mailobject.To

    If InStr(1, Email, "kovalovsky.com", vbTextCompare) Then
        If Not dic.Exists(Email) Then
            strEmails = strEmails + Email + vbCrLf
            dic.Add Email, ""
        End If
    End If
Next

a.WriteLine (strEmails)

Set OlApp = Nothing
Set Mailobject = Nothing
a.Close
End Sub

答案 1 :(得分:0)

我在Outlook中使用的代码:

我用它来复制到剪贴板但只有一封电子邮件它不适用于整个收件箱\ folderofchoice

您可以创建一个循环来打开您的电子邮件获取信息,然后关闭电子邮件等等...

Sub Get_SenderName()

 Dim myItem As Outlook.Inspector
 Dim objItem As Object
 Dim clipboard As MSForms.DataObject

 Set clipboard = New MSForms.DataObject
 Set myItem = Application.ActiveInspector

 If Not TypeName(myItem) = "Nothing" Then

   Set objItem = myItem.CurrentItem
   sSender = objItem.SenderName
   clipboard.SetText sSender
   clipboard.PutInClipboard

 Else
  ErrMsg = MsgBox("No Email Open To Get Data, Please Open Email To Use This.", vbInformation, "You Did It Wrong.")
 End If
End Sub