I have a userform with 3 textboxes and 1 button. I want to put an outlook alias into textbox1 (txtPID) and return the display type and email in boxes 2 & 3 (txtName & txtEmail)
this appears to connect to outlook and pull information but it's not searching the alias given in textbox 1
Load UsrFrmNewRep
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olGAL As Outlook.AddressList
Dim olMember As Outlook.AddressEntry
Dim olAliasName As String
Dim exchuser As Outlook.ExchangeUser
Set olApp = CreateObject("Outlook.Application")
Set olNS = olApp.GetNamespace("MAPI")
Set olGAL = olNS.AddressLists("Global Address List")
olAliasName = UsrFrmNewRep.txtPID.Value
Set olMember = olGAL.AddressEntries(olAliasName)
Set exchuser = olMember.GetExchangeUser
If Not exchuser Is Nothing Then
UsrFrmNewRep.txtName.Value = exchuser.DisplayType
UsrFrmNewRep.txtEmail.Value = exchuser.PrimarySmtpAddress
End If
End Sub
i'm sure i'm not referencing something correctly i'm just not sure what.
Thanks
Instead of using olGAL.AddressEntries(olAliasName), use olNS.CreateRecipient(olAliasName) / Recipient.Resolve / set olMember = Recipient.AddressEntry
Related
This question already has an answer here:
Select inboxes in different outlook accounts
(1 answer)
Closed 8 days ago.
I am trying to access a specific mail account in Outlook and going through the Sent Mail to get certain data from the mailbox.
I get a Run-time error ´438´ - Object doesn't support this property or method, when I reach
Set olSent = Account.GetDefaultFolder(olFolderSentMail)
I have used MsgBox Account.DisplayName and it showed me the correct account. I have swapped olFolderSentMail to 5. Always the same error.
Any idea what the issue could be?
Sub CopyEmailBodyToExcel()
Dim OutlookApp As Object
Dim MItem As Object
Dim xlSheet As Object
Dim RowCounter As Integer
Dim olNs As Object
Dim olSent As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set olNs = OutlookApp.GetNamespace("MAPI")
For Each Account In olNs.Accounts
If Account.SMTPAddress = testmymail#company.com Then
MsgBox Account.DisplayName
'Set olSent = Account.Folders("Sent Items")
Set olSent = Account.GetDefaultFolder(olFolderSentMail)
Exit For
End If
Next Account
Set xlSheet = Worksheets("Sheet3")
RowCounter = 1
For Each MItem In olSent
If MItem.Subject = "Payload Notification" Then
xlSheet.Cells(RowCounter, 1).Value = MItem.Body
RowCounter = RowCounter + 1
End If
Next MItem
xlApp.Visible = True
End Sub
In Microsoft Visual Basic, I had to go in Tools > References and add the Microsoft Outlook 16 Library.
I then changed to the following:
Dim olNs As Outlook.Namespace
Dim olSent As Outlook.MAPIFolder
Then I could follow the question the niton referenced to and changed the For Each Loop
For Each Account In olNs.Accounts
If Account.SMTPAddress = testmymail#company.com Then
Set olSent = Account.DeliveryStore.GetDefaultFolder(olFolderSentMail)
Exit For
End If
Next Account
Now it seems to work as promised.
I have a macro in Outlook named "DeleteMail", when I try to run it from excel somehow I get an error "438".
I think I'm missing something on before the last line.
Function OpenOL(Optional ProfileName) As Object
Dim objOL As Object
'On Error Resume Next
Set objOL = GetObject(, "Outlook.Application")
If objOL Is Nothing Then
Set objOL = CreateObject("Outlook.Application")
objOL.Session.Logon ProfileName, , False, True
End If
Set OpenOL = objOL
Call OpenOL.DeleteMail '***Error Here****
Set objOL = Nothing
End Function
Any help is appreciated.
Nick.
Apparently I was overthinking it.
I just had to put the first macro "DeleteMail" in Excel and run it from there instead of keeping it in Outlook and trying to run it from Excel.
Here was the macro, hope it helps someone.
Public Sub DeleteMail() ' Deletes Mail from a Folder on same level as Default Folders
Dim outApp As Outlook.Application
Dim delFolder As Outlook.MAPIFolder
Dim item As Object
Dim entryID As String
Set outApp = CreateObject("outlook.application")
'Set delFolder = outApp.GetNamespace("MAPI").GetDefaultFolder(olFolderJunk)' deletes Junk Mails
Set delFolder = outApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent.Folders("Meeting")
For i = delFolder.Items.Count To 1 Step -1
delFolder.Items(i).Delete
Next
Set item = Nothing
Set delFolder = Nothing
Set outApp = Nothing
End Sub
My company is transferring from Outlook 16 to Outlook 365, and the Excel VBA script below now needs to refer to a mailbox in Outlook 365.
It errors on the line
Set oMapi = oApp.GetNamespace("MAPI").Folders(strMail).Folders("inbox")
with the error
The attempted operation failed. An object could not be found.
Is it possible the mailbox needs to be added in a different way? Or is there a different way to do this function in Outlook 365?
I am not seeing much on a different way to do this with Outlook 365.
Sub Import_Email_Preferences()
Const strMail As String = "borrowerservicesshiftbid#glhec.org"
Dim oApp As Outlook.Application
Dim oMapi As Outlook.MAPIFolder
Dim oMail As Outlook.MailItem
Dim strEmailAddress As String
Dim strSenderName As String
Dim strSubject As String
Dim intRow As Integer
Dim i As Long
Dim tbl As ListObject
Dim ltblRow As Long
Set tbl = ThisWorkbook.Worksheets("Preferences").ListObjects(1)
ltblRow = tbl.DataBodyRange.Rows.Count
On Error Resume Next
Set oApp = GetObject(, "OUTLOOK.APPLICATION")
If (oApp Is Nothing) Then Set oApp = CreateObject("OUTLOOK.APPLICATION")
On Error GoTo 0
'Getting Error Here
Set oMapi = oApp.GetNamespace("MAPI").Folders(strMail).Folders("inbox")
For i = oMapi.Items.Count To 1 Step -1
Set oMail = oMapi.Items(i)
If TypeOf oMail Is Outlook.MailItem Then
MsgBox = "Blue"
End If
Next i
Set oApp = Nothing
Set oMapi = Nothing
Set oMail = Nothing
Set oHTML = Nothing
Set oElColl = Nothing
End Sub
Please try to reference the inbox by GetDefaultFolder:
On Error Resume Next
If oApp Is Nothing Then
Set oApp = GetObject(, "Outlook.Application")
If oApp Is Nothing Then
Set oApp = New Outlook.Application
End If
End If
On Error GoTo 0
Set oMapi = oApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
If the default folder ist not accessible, be aware that folder names are language dependent, e. g. Namespace.Folders("Posteingang") in German.
The trouble with Set oMapi = oApp.GetNamespace("MAPI").Folders(strMail).Folders("inbox") is you are stringing references together. This is fine if it works but you do not know what has failed if it does not.
Set oMapi = oApp.GetNamespace("MAPI") will fail if oApp is not an object.
Set oMapi = oApp.GetNamespace("MAPI").Folders(strMail) will fail if oApp.GetNamespace("MAPI") is not an object.
Set oMapi = oApp.GetNamespace("MAPI").Folders(strMail).Folders("inbox") will fail if oApp.GetNamespace("MAPI").Folders(strMail) is not an object.
I suggest trying the subroutine below to identify which step is failing. This subroutine does everything in single steps. It also tries different ways of achieving the same effect. If one Set fails, comment it out and see if the next one works.
I have suggested some possible causes of failures but I am sure there are other possibilities. Once you know the step that fails, come back if you need further help.
You may wish to try Asger suggestion of GetDefaultFolder as well. It does not work on my system because the default Inbox in not used. I have to name the store containing the Inbox I wish to access.
Sub TestGetInbox()
Dim olApp As Outlook.Application
Dim olInbox1 As Outlook.MAPIFolder
Dim olInbox2 As Outlook.Folder
Dim olInbox3 As Outlook.MAPIFolder
Dim olInbox4 As Outlook.Folder
Dim olNs As Outlook.Namespace
Dim olSession As Outlook.Namespace
Dim olStore1 As Outlook.Folder
Dim olStore2 As Outlook.Folder
' If execution stops her, you have a problem accessing Outlook
Set olApp = CreateObject("Outlook.Application")
' If execution stops here, you have a problem accessing Outlook's namespace
' using this method. Comment out statements down to "Set olSession = olApp.Session"
Set olNs = olApp.GetNamespace("MAPI")
' If execution stops here, look at your folder pane. Is "borrowerservicesshiftbid#glhec.org"
' the name of a store? Case does not seem to matter but a single letter change in the name
' does.
Set olStore1 = olNs.Folders("borrowerservicesshiftbid#glhec.org")
Debug.Print olStore1.Name
Set olInbox1 = olStore1.Folders("Inbox")
Debug.Print olInbox1.Name
Set olInbox2 = olStore1.Folders("Inbox")
Debug.Print olInbox1.Name
' If execution stops her, you have a problem accessing Outlook's namespace
' This is a different methods of accessing Outlook's namespace. The documentation
' says the two method are identical but I once had the olApp.Namespace("MAPI")
' fail so I now always use the olApp.Session method which has never failed for me.
Set olSession = olApp.Session
Set olStore2 = olSession.Folders("borrowerservicesshiftbid#glhec.org")
Debug.Print olStore2.Name
Set olInbox3 = olStore1.Folders("Inbox")
Debug.Print olInbox1.Name
Set olInbox4 = olStore1.Folders("Inbox")
Debug.Print olInbox1.Name
Set olInbox1 = Nothing
Set olInbox2 = Nothing
Set olStore1 = Nothing
Set olNs = Nothing
Set olInbox3 = Nothing
Set olInbox4 = Nothing
Set olStore2 = Nothing
Set olSession = Nothing
Set olApp = Nothing
End Sub
With the help of below coding I am able to retrieve the data from outlook inbox and update the same in excel.
The problem is that I am not able to update the latest response as macro read first come first update basis. If I get the response from abc yesterday and updated response from abc today, the macro is updating the yesterday's response. How can we change the code so that macro should read the emails from bottom of folder and the data that is pulled is updated.
In short, I want to update the latest response in my records.
Dim outlookApp As Outlook.Application, oOutlook As Object
Dim oInbox As Outlook.Folder, oMail As Outlook.MailItem
Dim strAddress As String, strEntryId As String, getSmtpMailAddress As String
Dim objAddressentry As Outlook.AddressEntry, objExchangeUser As Outlook.ExchangeUser
Dim objReply As Outlook.MailItem, objRecipient As Outlook.Recipient
Set outlookApp = New Outlook.Application
Set oOutlook = outlookApp.GetNamespace("MAPI")
Set oInbox = oOutlook.GetDefaultFolder(olFolderInbox)
For Each oMail In oInbox.Items
If oMail.SenderEmailType = "SMTP" Then
strAddress = oMail.SenderEmailAddress
Else
Set objReply = oMail.Reply()
Set objRecipient = objReply.Recipients.Item(1)
strEntryId = objRecipient.EntryID
objReply.Close OlInspectorClose.olDiscard
strEntryId = objRecipient.EntryID
Set objAddressentry = oOutlook.GetAddressEntryFromID(strEntryId)
Set objExchangeUser = objAddressentry.GetExchangeUser()
strAddress = objExchangeUser.PrimarySmtpAddress()
End If
getSmtpMailAddress = strAddress
body = oMail.body
Loop backwards:
For i = oInbox.Count To 1 Step -1
If TypeName(oInbox.item(i)) = "MailItem" Then
Set oMail = oInbox.item(i)
'Do stuff here
Set oMail = Nothing
End If
Next i
I am using MS Office 2010.
My Outlook is configured with two email IDs. One is client another one is company.
I have a code in Excel to check an Outlook distribution list and import member details into Excel.
I am able to import the details from a distribution list in the GAL for a default mail ID.
I am unable to select the distribution list in the GAL for other email.
It searches for the DL in the default account's GAL and selects the wrong name.
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olAL As Outlook.AddressList
Dim olEntry As Outlook.AddressEntry
Dim olMember As Outlook.AddressEntry
Dim lMemberCount As Long
Dim objMail As Outlook.MailItem
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olAL = olNS.AddressLists("Global Address List")
Set objMail = olApp.CreateItem(olMailItem)
' enter the list name
Set olEntry = olAL.AddressEntries(".DL IS Support")
' get count of dist list members
lMemberCount = olEntry.Members.Count