我尝试使用此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
知道我做错了什么?
答案 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