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.
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 been trying to import a contact's email based on an input name. I am not that good at macro programming but have found a code that works. However it only works by looking up the information in the contacts folder and I need it to lookup a contact in the Global Address List give me back the email associated with that person. I have searched through other posts and they all want to take every contact from outlook and paste it to excel. I only want to search the Global Address List for a person based on the input name and have it return the email of that person.
Here is what I have:
Function GrabContactInfo(rRng As Range, iWanted As Integer) As String
Dim olA As Outlook.Application
Dim olNS As Namespace
Dim olAB As MAPIFolder
Dim lItem As Long
Dim sNameWanted As String
Dim sRetValue As String
Set olA = New Outlook.Application
Set olNS = olA.GetNamespace("MAPI")
Set olAB = olNS.GetDefaultFolder(olFolderContacts)
Application.Volatile
sNameWanted = rRng.Value
sRetValue = "Not Found"
On Error Resume Next
For lItem = 1 To olAB.Items.Count
With olAB.Items(lItem)
If sNameWanted = .FullName Then
Select Case iWanted
Case 1
sRetValue = .CompanyName
Case 2
sRetValue = .BusinessAddress
Case 3
sRetValue = .BusinessAddressCity
Case 4
sRetValue = .BusinessAddressState
Case 5
sRetValue = .BusinessAddressPostalCode
Case 6
sRetValue = .BusinessTelephoneNumber
Case 7
sRetValue = .Email1Address
End Select
End If
End With
Next lItem
olA.Quit
GrabContactInfo = sRetValue
End Function
Any information is helpful
Instead of looping through all the items in the Contacts folder, you can use Namespace.CreateRecipient / Recipient.Resolve to resolve a name to an instance of the Recipient object. You can then use AddressEntry.GetContact to resolve it to an instance of the ContactItem object or AddressEntry.GetExchangeUser to get an instance of the ExchangeUser object:
Set olA = New Outlook.Application
Set olNS = olA.GetNamespace("MAPI")
set olRecip = olNS.CreateRecipient("Dmitry Streblechenko")
olRecip.Resolve
set olAddrEntry = olRecip.AddressEntry
set olCont = olAddrEntry.GetContact
if not (olCont Is Nothing) Then
'this is a contact
'olCont is ContactItem object
MsgBox olCont.FullName
Else
set olExchUser = olAddrEntry.GetExchangeUser
if not (olExchUser Is Nothing) Then
'olExchUser is ExchangeUser object
MsgBox olExchUser.StreetAddress
End If
End If
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.
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.