此代码适用于具有两个帐户的个人计算机。 (OutLook 2013。)
在我有四个帐户的工作中,我收到以下错误消息(OutLook 2007。):
“Excel VBA,错误438”对象不支持此属性或方法“
代码(MSG信箱邮件是瑞典语):
Sub GetAttachments()
On Error GoTo GetAttachments_err
Dim ns As NameSpace
Dim Item As Object
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer
Dim varResponse As VbMsgBoxResult
Dim oStore As Store
Dim Inbox As MAPIFolder
Dim bFound As Boolean
For Each oStore In Outlook.Session.Stores
If oStore = "invoice@xxx.com" Then
Set Inbox = oStore.GetDefaultFolder(olFolderInbox)
bFound = True
Exit For
End If
Next oStore
If Not bFound Then
MsgBox ("Account 'invoice@xxx.com' not found")
Exit Sub
End If
Set ns = GetNamespace("MAPI")
i = 0
If Inbox.Items.Count = 0 Then
MsgBox "Det finns inga meddelanden i din Inbox.", vbInformation, _
"Hittade inget"
Exit Sub
End If
If Inbox.UnReadItemCount = 0 Then
MsgBox "Det finns inga nya meddelanden i din Inbox.", vbInformation, _
"Hittade inget"
Exit Sub
End If
For Each Item In Inbox.Items
For Each Atmt In Item.Attachments
If Item.UnRead = True Then
If Right(Atmt.FileName, 3) = "pdf" Then
FileName = "C:\Users\xxx\Desktop\Inboxtest\" &
Format(Item.CreationTime, "yyyymmdd_hhnnss_") & Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
End If
End If
Next Atmt
Next Item
If i > 0 Then
varResponse = MsgBox("Jag har hittat " & i & " bifogade .pdf filer." _
& vbCrLf & "Jag har sparat dem till C:\Users\xxx\Desktop\Inboxtest\" _
& vbCrLf & vbCrLf & "Vill du se dina sparade filer nu?" _
, vbQuestion + vbYesNo, "Klart!")
If varResponse = vbYes Then
Shell "Explorer.exe /e,C:\Users\xxx\Desktop\Inboxtest\", vbNormalFocus
End If
Else
MsgBox "Jag hittade inga bifogade .pdf filer i din mail.", vbInformation, _
"Klar!"
End If
GetAttachments_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Exit Sub
GetAttachments_err:
MsgBox "A ghost messed something up!"
& vbCrLf & "Please note and report the following information." _
& vbCrLf & "Macro Name: GetAttachments" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
Resume GetAttachments_exit
Exit Sub
End Sub
答案 0 :(得分:0)
哪行代码会导致错误?您是否尝试调试代码?
Outlook 2007中存在所有Outlook对象模型属性和方法。我在代码中看不到任何新成员。尝试使用完整的属性defionition:
Set ns = GetNamespace("MAPI")
使用以下语句:
Set ns = Application.GetNamespace("MAPI")
此外,我建议打破调用链并在单行代码上声明属性或方法调用。不要在单行代码中使用多个点。
For Each Item In Inbox.Items
答案 1 :(得分:0)
Outlook 2007中的商店对象不会公开GetDefaultFolder方法。
如果使用Redemption是一个选项,则它是RDOStore。GetDefaultFolder方法适用于所有版本的Outlook。