I been trying to find out a way to find out which mail addresses a mail has been sent to. Consider the following:
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim mai As MailItem
Dim intInitial As Integer
Dim intFinal As Integer
Dim strEntryId As String
Dim intLength As Integer
intInitial = 1
intLength = Len(EntryIDCollection)
intFinal = InStr(intInitial, EntryIDCollection, ",")
Do While intFinal <> 0
strEntryId = Strings.Mid(EntryIDCollection, intInitial, (intFinal - intInitial))
Set mai = Application.Session.GetItemFromID(strEntryId)
intInitial = intFinal + 1
intFinal = InStr(intInitial, EntryIDCollection, ",")
Loop
strEntryId = Strings.Mid(EntryIDCollection, intInitial, (intLength - intInitial) + 1)
MsgBox strEntryId
Set mai = Application.Session.GetItemFromID(strEntryId)
For Each Recipient In mai.Recipients
MsgBox Recipient
Next
End sub
In those msgBoxes I get the "nice name", Like "John Doe" - but I want to get the mail address, "john.doe#gmail.com".
How can I achieve this?
I assume this is Outlook 2007+. Have you tried the Address Property?
For Each Recipient In mai.Recipients
MsgBox Recipient.Address
Next Recipient
This should print the email address of each recipient.
Related
I edited a VBA code that I got from the internet in order to fetch recipient email address and all email addresses from CC field. The code below is just showing only one email address, however there are multiple recipients. How can I edit the below program to get all recipients from SendTo and CopyTo fields.
Public Sub Get_Notes_Email_Address()
Dim NSession As Object 'NotesSession
Dim NMailDb As Object 'NotesDatabase
Dim NDocs As Object 'NotesDocumentCollection
Dim NDoc As Object 'NotesDocument
Dim NNextDoc As Object 'NotesDocument
Dim NItem As Object 'NotesItem
Dim view As String
Dim vn As Integer
Dim filterText As String
filterText = "text to search"
Set NSession = CreateObject("Notes.NotesSession")
'Set NMailDb = NSession.CurrentDatabase
Set NMailDb = NSession.getDatabase("<SERVERNAME>", "<LOCATION>")
'MsgBox NMailDb.AllEntries()
If Not NMailDb.IsOpen Then
NMailDb.OPENMAIL
End If
Set NDocs = NMailDb.AllDocuments
If filterText <> "" Then
NDocs.FTSEARCH filterText, 0
End If
'MsgBox NDocs.Count
Set NDoc = NDocs.GetFirstDocument
'MsgBox NDocs.GetFirstDocument
vn = 2
Do Until NDoc Is Nothing
Set NNextDoc = NDocs.GetNextDocument(NDoc)
Set NItem = NDoc.GETFIRSTITEM("Body")
If Not NItem Is Nothing Then
Cells(vn, 3) = NDoc.GETITEMVALUE("Subject")(0)
'MsgBox prompt:=NDoc.GETITEMVALUE("CopyTo")(0), Title:="CopyTo"
Cells(vn, 4) = NDoc.GETITEMVALUE("CopyTo")
'MsgBox prompt:=NDoc.GETITEMVALUE("SendTo")(0), Title:="SendTo"
Cells(vn, 5) = NDoc.GETITEMVALUE("SendTo")
End If
Set NDoc = NNextDoc
vn = vn + 1
Loop
'reset all objects to null
Set NMailDb = Nothing
Set NSession = Nothing
End Sub
You are calling GetItemValue in this line:
Cells(vn, 4) = NDoc.GETITEMVALUE("CopyTo")
This function returns an array. Instead of retrieving it directly into the cell, you need to read it into a variable. You need to write a loop that examines this variable as an array -- copying the entries of this array, starting at subscript zero, into your cell.
I have a script to iterate through my calendar events that day and produce in a separate email a list in the following format:
Event 1:
Subject:
When:
Attendees:
The function, which lists all attendees:
Function listAttendees(ByRef item As Variant, myself As String, ByRef nicknames As Scripting.Dictionary) As String
listAttendees = ""
'Dim pa As Outlook.PropertyAccessor
Dim sAtt As String
For i = 1 To item.Recipients.Count
sAtt = item.Recipients.item(i).AddressEntry.GetExchangeUser().FirstName & " " & item.Recipients.item(i).AddressEntry.GetExchangeUser().LastName
sAtt = cleanName(sAtt)
If nicknames.Exists(sAtt) Then
sAtt = nicknames(sAtt)
End If
If sAtt <> myself Then
If listAttendees <> "" Then
listAttendees = listAttendees & ", "
End If
listAttendees = listAttendees & "[[" & sAtt & "]]"
End If
Next
End Function
I get
Runtime error 91 - object variable or with block variable not set
The error points to:
sAtt = item.Recipients.item(i).AddressEntry.GetExchangeUser().FirstName & " " & item.Recipients.item(i).AddressEntry.GetExchangeUser().LastName
This script was working a few days ago.
The GetExchangeUser method should be called only if the AddressEntry.AddressEntryUserType property is set to the olExchangeUserAddressEntry value. Here is what MSDN states for the property:
AddressEntryUserType provides a level of granularity for user types that is finer than that of AddressEntry.DisplayType. The DisplayType property does not distinguish users with different types of AddressEntry, such as an AddressEntry that has a Simple Mail Transfer Protocol (SMTP) email address, a Lightweight Directory Access Protocol (LDAP) address, an Exchange user address, or an AddressEntry in the Outlook Contacts Address Book. All these entires have olUser as their AddressEntry.DisplayType.
For illustration purposes take a look how it can be used in the code:
Sub DemoAE()
Dim colAL As Outlook.AddressLists
Dim oAL As Outlook.AddressList
Dim colAE As Outlook.AddressEntries
Dim oAE As Outlook.AddressEntry
Dim oExUser As Outlook.ExchangeUser
Set colAL = Application.Session.AddressLists
For Each oAL In colAL
'Address list is an Exchange Global Address List
If oAL.AddressListType = olExchangeGlobalAddressList Then
Set colAE = oAL.AddressEntries
For Each oAE In colAE
If oAE.AddressEntryUserType = olExchangeUserAddressEntry Then
Set oExUser = oAE.GetExchangeUser
Debug.Print(oExUser.JobTitle)
Debug.Print(oExUser.OfficeLocation)
Debug.Print(oExUser.BusinessTelephoneNumber)
End If
Next
End If
Next
End Sub
I have 2 email box account in my outlook so How can I change email account when I'm sending Email
"From"
Enter image description here
I need to send from my email address "anas3643#hotmail.com"
Sub Test_for_using()
'MVP OShon from VBATools.pl
Dim oMail As MailItem
On Error GoTo blad
Select Case TypeName(Application.ActiveWindow)
Case "Explorer": Set oMail = ActiveExplorer.Selection.Item(2)
Case "Inspector": Set oMail = ActiveInspector.CurrentItem
Case Else: Exit Sub
End Select
Call odpowiedz_do_nadawcy(oMail)
blad:
End Sub
Sub odpowiedz_do_nadawcy(Item As Outlook.MailItem)
Dim oReply As MailItem
With Item
Set oReply = .Forward
Dim MyValue As Integer
Dim x As String
Dim emailNames(19) As String
emailNames(1) = "anas.alwasel11#gmail.com"
emailNames(2) = "anas3643#hotmail.com"
emailNames(3) = "anas.alwasel11#gmail.com"
emailNames(4) = "anas3643#hotmail.com"
emailNames(5) = "anas.alwasel11#gmail.com"
emailNames(6) = "anas3643#hotmail.com"
emailNames(7) = "anas.alwasel11#gmail.com"
emailNames(8) = "anas3643#hotmail.com"
emailNames(9) = "anas.alwasel11#gmail.com"
emailNames(10) = "anas3643#hotmail.com"
emailNames(11) = "anas.alwasel11#gmail.com"
emailNames(12) = "anas3643#hotmail.com"
emailNames(13) = "anas.alwasel11#gmail.com"
emailNames(14) = "anas3643#hotmail.com"
emailNames(15) = "anas.alwasel11#gmail.com"
emailNames(16) = "anas3643#hotmail.com"
emailNames(19) = "anas3643#hotmail.com"
MyValue = CInt(Int((19 * rnd()) + 1)) ' Generate random value between 1 and 6.
x = emailNames(MyValue)
oReply.Forward
oReply.Recipients.Add (x)
oReply.Send
Set oReply = Item
End With
End Sub
MailItem.SendUsingAccount Property
Returns or sets an Account object that represents the account under
which the MailItem is to be sent. (Read/write.)
Syntax:
expression . SendUsingAccount
expression : An expression that returns a MailItem object.
Remarks:
The SendUsingAccount property can be used to specify the account
that should be used to send the MailItem when the Send method is
called. This property returns Null if the account specified for the
MailItem no longer exists.
More information at the Source.
The idea is to scan incoming emails for a particular subject line, extract and reply to the email address from the first line of the email.
The issue lies in the emailC line, where it is telling me it is an invalid procedure call or argument.
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim mymail As Outlook.MailItem
Dim ns As Outlook.NameSpace
Set ns = Application.GetNamespace("MAPI")
Set mymail = ns.GetItemFromID(EntryIDCollection)
Substr = Trim(mymail.Subject)
If InStr(1, Substr, "TEST SUBJECT") > 0 Then
sText = mymail.Body
vText = Split(sText, Chr(13), -1, vbTextCompare)
'Find the next empty line of the worksheet
emailC = Trim(Left(sText, InStr(sText, "<") - 1)) 'Split(vText(0), " ", -1, vbTextCompare)
Resultstr = Trim(Mid(sText, InStr(sText, ">") + 1))
senderstr = mymail.SenderEmailAddress
Call SendReply(emailC, mymail.Subject, Resultstr, senderstr)
End If
End Sub
Private Sub SendReply(Tostr, Subjectstr, Bodystr, senderstr)
Dim mymail2 As Outlook.MailItem
Set mymail2 = Application.CreateItem(olMailItem)
nam = mymail2.Session.CurrentUser.Name
With mymail2
.To = senderstr
.Subject = "RE: " & Subjectstr
.ReplyRecipients.Add emailC
.Body = Replace(Bodystr, Tostr, "", 1, -1, vbTextCompare)
End With
mymail2.Send
End Sub
Most likely the mail Body does not contain any '<' or '>'. In that case, the Instr will return 0, and you end up with a command left(sText, -1) which will exacly throw the error you describe
For a starter, change your code
dim p as integer
p = InStr(sText, "<")
if p = 0 then
debug.Print "no '<' found, text = :" & sText
else
emailC = Trim(Left(sText, p - 1))
....
After that you have to make up your mind what to do in such a case (and you should also the case that you find a '<' but no '>')
Perhaps the < and > are in sText represented as < and >.
It's generally good practice to declare all your variables even if they're just Strings.
I would do this for all the String's you're using. I would also change your SendReply routine as follows:
Private Sub SendReply(ByVal Tostr as String, ByVal Subjectstr as String, ByVal Bodystr as String, ByVal senderstr as String)
From memory, if you don't do the above, the code doesn't know what data type the variables should be.
I would like to move all received emails that are not from my company's domain (Ex. JohnDeer#tractorworld.com) and does not have my company's name in the subject field to the spam folder.
Here is what I have so far but it gives me a type mismatch error after a couple of hundred iterations:
Sub SpamHunter()
Dim inBox As Folder
Set inBox = Session.GetDefaultFolder(olFolderInbox)
MsgBox ("Items Found: " & inBox.Items.count)
Dim mailItem As mailItem
Dim b As Long
Dim mailAddress As String
Dim mailSubject As String
Dim mailReceived As Date
Dim c As Integer
c = 0
For Each mailItem In inBox.Items
c = c + 1
mailAddress = mailItem.SenderEmailAddress
mailSubject = mailItem.Subject
mailReceived = mailItem.ReceivedTime
b = InStr(mailAddress, "mycompany")
b = b + InStr(mailAddress, "myothercompany")
If b < 1 Then
mailItem.Move (Session.GetDefaultFolder(olFolderInbox).Folders("_Junk"))
End If
Next
End Sub
Not everything in the inbox is a MailItem. For example a meeting request is not a MailItem.
You need to check that the item is a mailitem before you cast it to that type.
Dim o as Object
Dim ixItems as Integer
For ixItems = inBox.Items.Count To 1 Step -1
Set o = inBox.Items.Item(ixItems)
if TypeName(o) = "MailItem" Then
Set mailItem = o
' loop goes here
c = c + 1
mailAddress = mailItem.SenderEmailAddress
mailSubject = mailItem.Subject
mailReceived = mailItem.ReceivedTime
b = InStr(mailAddress, "mycompany")
b = b + InStr(mailAddress, "myothercompany")
If b < 1 Then
mailItem.Move (Session.GetDefaultFolder(olFolderInbox).Folders("_Junk"))
End If
End If
Next
Also, a tip: don't let your variable names clash with type names. I suggest calling your variable oMailItem or similar so it is obvious it is a variable not a type.