
Ich arbeite mit meinem eigenen Postfach, aber auch mit einem freigegebenen Postfach. Ich habe ein Makro, um Anhänge in E-Mails, die ich erhalte, automatisch zu speichern, aber das funktioniert nur für mein eigenes Postfach und nicht für das freigegebene Postfach. Können Sie mir bitte sagen, wie ich das erreichen kann?
Das habe ich bisher:
Private Declare Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim Ns As Outlook.NameSpace
Dim Folder As Outlook.MAPIFolder
Set Ns = Application.GetNamespace("MAPI")
Set Folder = Ns.GetDefaultFolder(olFolderInbox)
Set Items = Folder.Items
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.MailItem Then
PrintAttachments Item
End If
End Sub
Private Sub PrintAttachments(oMail As Outlook.MailItem)
On Error Resume Next
Dim colAtts As Outlook.Attachments
Dim oAtt As Outlook.Attachment
Dim sFile As String
Dim sDirectory As String
Dim sFileType As String
sDirectory = "I:\Finance_Administration\MMR\Attachments\"
Set colAtts = oMail.Attachments
If colAtts.Count Then
For Each oAtt In colAtts
' This code looks at the last 4 characters in a filename
sFileType = LCase$(Right$(oAtt.FileName, 4))
Select Case sFileType
' Add additional file types below
Case ".xls", ".doc", "docx", ".pdf"
sFile = sDirectory & oAtt.FileName
oAtt.SaveAsFile sFile
'ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
End Select
Next
End If
End Sub
Antwort1
Um es im freigegebenen Posteingang auszuführen, versuchen Sie, IhrevbaCode
Beispiel
Private Sub Application_Startup()
Dim Ns As Outlook.NameSpace
Dim Folder As Outlook.Folder
Dim olShareName As Outlook.Recipient
Set Ns = Application.GetNamespace("MAPI")
Set olShareName = Ns.CreateRecipient("[email protected]") '// Owner's email address
Set Folder = Ns.GetSharedDefaultFolder(olShareName, olFolderInbox) '// Inbox
Set Items = Folder.Items
End Sub