I'm trying to open the Outlook application from Access VBA when the switchboard loads. I've opened task manager and I can see an instance of Outlook appear for about 5 seconds then close, but I can't get the explorer window to open. I've been trying to piece together code from VBA: Determining whether an existing Outlook instance is open and other sources, but it's just not working. Any ideas?
And I would like to stick with late bindings so I don't have to worry about object libraries if someone opens with XP.
Function OpenEmail()
Dim olApp As Object ' Outlook.Application
Dim olFolderInbox As Object
Dim objExplorer As Object
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If olApp Is Nothing Then
MsgBox "Outlook is not Open"
Set olApp = CreateObject("Outlook.Application")
End If
Set objExplorer = CreateObject("Outlook.MAPIFolder")
Set objExplorer = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
objExplorer.Activate
'Set olApp = Nothing
End Function
Outlook is the only MS Office application where GetObject does the same thing as CreateObject. Unlike other MS Office application, CreateObject doesn't create multiple instances of Outlook.
Also olFolderInbox is an outlook constant. You will have to define it in ACCESS.
Try this
Const olFolderInbox As Long = 6
Sub Sample()
Dim olApp As Object
Dim objNS As Object
Dim olFolder As Object
Set olApp = CreateObject("Outlook.Application")
Set objNS = olApp.GetNamespace("MAPI")
Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
With olFolder
'~~> Do what you want
End With
End Sub
Related
With this bit of VBA code in MS Access I'm getting an error if its executed too often. The only way I've found to clear it is reboot my computer. Any idea why and what can I do?
Public Function HasOutlookAcct(strEmail As String) As Boolean
Dim OutMail As Object
Dim OutApp As OutLook.Application
Dim objNs As OutLook.NameSpace
Dim objAcc As Object
'https://stackoverflow.com/questions/67284852/outlook-vba-select-sender-account-when-new-email-is-created
Set OutApp = CreateObject("Outlook.Application")
Set objNs = OutApp.GetNamespace("MAPI")
For Each objAcc In objNs.Accounts
If objAcc.SmtpAddress = strEmail Then
HasOutlookAcct = True
Exit For
End If
Next
OutApp.Quit
Set objAcc = Nothing
Set objNs = Nothing
End Function
The code looks good. The NameSpace.Accounts property returns an Accounts collection object that represents all the Account objects in the current profile. I don't see any extensive or heavy usage of the Outlook object model, but creating a new Outlook Application instance in the method for checking whether a particular account is configured in Outlook or not is not the best way of using Outlook. Instead, I'd recommend running Outlook once at some point and getting all the configured emails for saving for future usage where necessary.
Also it makes sense to disable all COM add-ins to see whether it helps or not. The problem may be related to any specific COM add-in.
Appears the error is addressed by considering the user.
The assumption, based on my results, is Outlook is not cleaned up completely when the user's instance is closed with outApp.Quit.
When Outlook is open, outApp.Quit is not applied and Outlook remains open at the end.
When Outlook is not open, it is opened in the background and later closed with outApp.Quit.
There is zero or one instance of Outlook at any time.
Option Explicit
Public Function HasOutlookAcct(strEmail As String) As Boolean
'Reference Outlook nn.n Object Library
' Consistent early binding
Dim outApp As Outlook.Application
Dim objNs As Outlook.Namespace
Dim objAcc As Outlook.Account
Dim bCreated As Boolean
On Error Resume Next
Set outApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If outApp Is Nothing Then
bCreated = True
Set outApp = CreateObject("Outlook.Application")
End If
Set objNs = outApp.GetNamespace("MAPI")
For Each objAcc In objNs.Accounts
'Debug.Print objAcc.SmtpAddress
If objAcc.SmtpAddress = strEmail Then
HasOutlookAcct = True
Exit For
End If
'Set objAcc = Nothing ' Additional cleanup if needed
Next
If bCreated = True Then ' Outlook object had to be created
outApp.Quit
End If
'Set outApp = Nothing ' Additional cleanup if needed
Set objNs = Nothing
End Function
Private Sub HasOutlookAcct_Test()
Dim x As Boolean
Dim sEmail As String
sEmail = "someone#somewhere.com"
Dim i As Long
For i = 1 To 50
Debug.Print i & ": " & sEmail
x = HasOutlookAcct(sEmail)
Debug.Print " HasOutlookAcct: " & x
DoEvents
Next
Debug.Print "done"
End Sub
I am having an issue with accessing a subfolder from a shared Outlook email box using VBA. The goal of this code is to download attachments from emails located in a subfolder called "Example_Subfolder". The code below results in an error message; "Run-time error '-2147221233 (8004010f)': The attempted operation failed. An object could not be found.".
Sub foo()
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim destFolder As Outlook.MAPIFolder
Dim srcFolder As Outlook.MAPIFolder
Dim olItem As Object
Dim subFolder As Object
Dim mailitem As Outlook.mailitem
Dim olAtt As Outlook.Attachment
Dim objOwner As Outlook.Recipient
Set olApp = New Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
'set object to shared email inbox
Set objOwner = olNS.CreateRecipient("Shared_Mailbox#companyname.com")
objOwner.Resolve
'check object resolved
If Not objOwner.Resolved Then
Debug.Print objOwner.Name
MsgBox "Failed to connect to shared email. Contact XXX."
End If
Set olFolder = olNS.GetSharedDefaultFolder(objOwner, olFolderInbox)
'error on next line.
Set subFolder = olFolder.Folders("Example_Subfolder")
'download email attachments
'etc
'etc
End Sub
The only way I've been able to access the emails inside "Example_Subfolder" is by using Set subFolder = olNS.PickFolder. I would rather not use this method in my macro. Can anyone point me in the right direction as to why my code doesn't work?
Given the folder is visible in the navigation pane there is an alternative.
Sub foo()
Dim olNS As namespace
Dim olMailbox As Folder
Dim olInbox As Folder
Dim subFolder As Folder
Set olNS = GetNamespace("MAPI")
' If the folder is in the navigation pane
Set olMailbox = olNS.Folders("Shared_Mailbox#companyname.com")
Set olInbox = olMailbox.Folders("Inbox")
Set subFolder = olInbox.Folders("Example_Subfolder")
subFolder.Display
End Sub
I've tried countless ways of deleting items from a custom folder called "Spam Digests" older than 14 days. I have successfully done this when I nest this folder underneath the olDefaultFolder(Inbox) but when I have it outside of the default inbox, I cannot reference it as I receive object not found.
Here is what I have and I cannot seem to figure out why the object is not found when referencing "fldSpamDigest"
Dim outapp As Outlook.Application
Set outapp = CreateObject("outlook.application")
Dim olitem As Object
Dim fldSpamDigest As Outlook.MAPIFolder
Set fldSpamDigest = outapp.GetNamespace("MAPI").Folders("Spam Digests")
For Each olitem In fldSpamDigest.Items
If DateDiff("d", olitem.CreationTime, Now) > 14 Then olitem.Delete
Next
Set fldSpamDigest = Nothing
Set olitem = Nothing
Set outapp = Nothing
GetDefaultFolder(olFolderInbox) is a shortcut.
You can reference any folder the long way.
Sub reference_walk_the_path()
Dim outapp As Outlook.Application
Set outapp = CreateObject("outlook.application")
Dim olitem As Object
Dim fldSpamDigest As Outlook.MAPIFolder
' from the default inbox to the parent which is your mailbox
Set fldSpamDigest = outapp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent
' from the mailbox to a folder at the same level as the Inbox
Set fldSpamDigest = fldSpamDigest.folders("Spam Digests")
' or
' directly from the mailbox to a folder at the same level as the Inbox
'Set fldSpamDigest = outapp.GetNamespace("MAPI").folders("your email address").folders("Spam Digests")
For Each olitem In fldSpamDigest.Items
If dateDiff("d", olitem.CreationTime, Now) > 14 Then olitem.Delete
Next
Set fldSpamDigest = Nothing
Set olitem = Nothing
Set outapp = Nothing
End Sub
Dim outapp As Outlook.Application
Set outapp = CreateObject("outlook.application")
There is no need to create a new Outlook Application instance in the Outlook VBA, simply use the Application property
To reference a folder that is not under default Inbox - example would be
Option Explicit
Public Sub Example()
Dim olNs As Outlook.NameSpace
Set olNs = Application.Session
Dim Digest_Fldr As Outlook.MAPIFolder
Set Digest_Fldr = olNs.GetDefaultFolder(olFolderInbox) _
.Parent.Folders("fldSpamDigest")
Dim Items As Outlook.Items
Set Items = Digest_Fldr.Items
Dim i As Long
For i = Items.Count To 1 Step -1
DoEvents
Debug.Print Items(i).Subject
Next
End Sub
My Outlook macro worked at one time, then stopped. When it parses, the macro throws an error "Compile Error: Variable not defined". It seems the macro does not recognize that that folder exists. I cut the code to the bare minimum and it is a repeatable problem. The macro will recognize standard folders such as JUNK and DRAFTS but not PROCESSED_FOLDERS. I have tried renaming Processed_Folders as well as creating a new folder with a different name. No joy.
Folder structure is:
reports#xxx.com
Inbox
Drafts
Sent
Trash
Junk
Processed_Reports
Outbox
Sync Issues1 (This computer only)
SearchFolders
CODE:
Sub testfforfolder()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim msg As Outlook.MailItem
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
On Error GoTo xyz
Set olFolder = olFolder.Folders("Processed_Reports")
MsgBox "Folder Exists" ' This line works if I use DRAFTS or JUNK
Exit Sub
xyz:
MsgBox ("Cannot find Folder") ' I get here if I use PROCESSED_REPORTS
Exit Sub
End Sub
Thanks to the comment by Tony Dallimore I was able to solve the issue. The link to https://stackoverflow.com/a/12146315/973283 let me solve the problem. With an updated version of Outlook, the default email account was being referenced rather than the account of the selected item. The Processed_Reports folder only existed in a different account folder. The solution, as Tony suggested, was to set the target folder to the full path to the target. I did need one more level as shown in the working solution below.
Sub testfforfolder()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim msg As Outlook.MailItem
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
On Error GoTo xyz
'OLD INCORRECT
'Set olFolder = olFolder.Folders("Processed_Reports")
'WORKING CORRECTION
Set TgtFolder= _
Session.Folders("reports#xxx.com"). _
Folders("Inbox").Folders("Processed_Reports")
MsgBox "Folder Exists" ' This line works if I use DRAFTS or JUNK
Exit Sub
xyz:
MsgBox ("Cannot find Folder") ' I get here if I use PROCESSED_REPORTS
Exit Sub
End Sub
here is a way to get the session folder without knowing the session name
Sub topFolder()
Dim topFolder As Folder
Set topFolder = Application.Session.GetDefaultFolder(olFolderInbox).Parent
Dim i As Integer
For i = 1 To topFolder.Folders.Count
Debug.Print topFolder.Folders(i).Name
Next i
For i = 1 To topFolder.Folders("inbox").Folders.Count
Debug.Print topFolder.Folders("inbox").Folders(i).Name
Next i
End Sub
I am trying to transfer one piece of code to another workbook. The code works perfectly on workbook1 but generates a
compile error User-defined type not defined
When run on workbook2.
Here is the code in question.
' Set up Outlook Namespace
Set OL = CreateObject("Outlook.Application")
Dim olNS As Outlook.Namespace
Dim olFol As Outlook.Folder
Set olNS = OL.GetNamespace("MAPI")
Set olFol = olNS.GetDefaultFolder(olFolderInbox)
' Current users address
Address = olNS.Accounts.Item(1).SmtpAddress
The error comes from olNS As Outlook.Namespace
The error is generated because although you use late binding for OL you are still using early binding for olNS and have likely not set the reference for Outlook in the second workbook.
If you want to use late binding then do this, e.g.:
Dim olNS As Object
Set olNS = CreateObject("Outlook.Namespace")
Dim olFol As Object
Set olFol = CreateObject("Outlook.Folder")
'etc...
Or just set a reference to Outlook in the second workbook: