Super User Asked by Madter on December 20, 2020
I have this code for saving attachments from e-mails with a specific sender and topic, down to my hard drive. It works fine when it is only working on my personal mailbox. But i need it to work with the shared mailbox i have with my co-workers.
I have this code in the “ThisOutlookSession”:
Private WithEvents olInboxItems As Items
Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.Session
Set olInboxItems = GetFolderPath("name of the shared mailboxInbox").Items
Set objNS = Nothing
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
'Only act if it's a MailItem
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
'Change variables to match need. Comment or delete any part unnecessary.
If (Msg.SenderName = "Sender name") And _
(Msg.Subject = "test") And _
(Msg.Attachments.Count >= 1) Then
'Set folder to save in.
Dim olDestFldr As Outlook.MAPIFolder
Dim myAttachments As Outlook.Attachments
Dim Att As String
'location to save in. Can be root drive or mapped network drive.
Const attPath As String = "U:TESTING"
' save attachment
Set myAttachments = item.Attachments
Att = myAttachments.item(1).DisplayName
myAttachments.item(1).SaveAsFile attPath & Att
' mark as read
Msg.UnRead = False
End If
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
Then i have this GetFolderPath function in my module:
' Use the GetFolderPath function to find a folder in non-default mailboxes
Function GetFolderPath(ByVal FolderPath As String) As Outlook.Folder
Dim oFolder As Outlook.Folder
Dim FoldersArray As Variant
Dim i As Integer
On Error GoTo GetFolderPath_Error
If Left(FolderPath, 2) = "\" Then
FolderPath = Right(FolderPath, Len(FolderPath) - 2)
End If
'Convert folderpath to array
FoldersArray = Split(FolderPath, "")
Set oFolder = Application.Session.Folders.item(FoldersArray(0))
If Not oFolder Is Nothing Then
For i = 1 To UBound(FoldersArray, 1)
Dim SubFolders As Outlook.Folders
Set SubFolders = oFolder.Folders
Set oFolder = SubFolders.item(FoldersArray(i))
If oFolder Is Nothing Then
Set GetFolderPath = Nothing
End If
Next
End If
'Return the oFolder
Set GetFolderPath = oFolder
Exit Function
GetFolderPath_Error:
Set GetFolderPath = Nothing
Exit Function
End Function
Do you have any suggestions to why it won’t work?
Thanks a lot
I am not sure if this is still a question anyone has but I have the answer for you.
When using and event handler like this, it needs to be a class object.
For example in class ClassModuleName:
Public WithEvents EventHandler As Items 'note the public it is required
Private Sub EventHandler_ItemAdd(ByVal item As Object) 'note the change in name.
On Error GoTo ErrorHandler
'Only act if it's a MailItem
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
'Change variables to match need. Comment or delete any part unnecessary.
If (Msg.SenderName = "Sender name") And _
(Msg.Subject = "test") And _
(Msg.Attachments.Count >= 1) Then
'Set folder to save in.
Dim olDestFldr As Outlook.MAPIFolder
Dim myAttachments As Outlook.Attachments
Dim Att As String
'location to save in. Can be root drive or mapped network drive.
Const attPath As String = "U:TESTING"
' save attachment
Set myAttachments = item.Attachments
Att = myAttachments.item(1).DisplayName
myAttachments.item(1).SaveAsFile attPath & Att
' mark as read
Msg.UnRead = False
End If
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
then in your actual session it will be:
Dim AnyName as New ClassModuleName
Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.Session
Set AnyName= GetFolderPath("name of the shared mailboxInbox").Items
Set objNS = Nothing
End Sub
this initializes the handler as a new object and assigns it to the desired folder while giving it the event option "addItem"
Answered by DrKEWatson on December 20, 2020
The reason its not working, is because you need to add the shared mailbox as a second account. Only then will VBA be able to find the mailbox and work with it.
You can simply add the mailbox by providing the email address and a fake password. Once the login prompt comes, enter your own email address/username and password and it will be added as a second mail address.
Note, you have to close outlook and reopen it (maybe twice) before it will merge both accounts as one account. Otherwise you'll see it twice.
Answered by LPChip on December 20, 2020
Get help from others!
Recent Answers
Recent Questions
© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP