我正在尝试运行此宏来将电子邮件附件从我的收件箱中的文件夹(称为工具包下载)移动到桌面上的文件夹中并重命名附件。
我得到了
运行时错误'':对象不支持此属性或方法
Sub OSP()
Dim oOutlook As Outlook.Application
Dim oNs As Outlook.NameSpace 'Main Outlook Today
Dim oFldrSb As Outlook.MAPIFolder 'Sub Folder in Outlook Today
Dim oFldrSbSb As Outlook.MAPIFolder 'Sub in Sub Folder
Dim oFldrSbSbsb As Outlook.MAPIFolder 'Sub in Sub in Sub Folder
Dim oMessage As Object
Dim sPathName As String
Dim oAttachment As Outlook.Attachment
Dim Ictr As Integer
Dim iAttachCnt As Integer
sPathName = "H:\Desktop\Toolkit Downloads\" 'My Folder Path where to save attachments
Set oOutlook = New Outlook.Application
Set oNs = oOutlook.GetNamespace("MAPI")
Set oFldrSb = oNs.Folders("Joe.Bloggs@test.co.uk")
Set oFldrSbSb = oFldrSb.Folders("Inbox")
Set oFldrSbSbsb = oFldrSbSb.Folders("Toolkit Downloads")
For Each oMessage In oFldrSbSbsb.Items
With oMessage.Attachments
iAttachCnt = .Count
If iAttachCnt > 0 Then
For Ictr = 1 To iAttachCnt
.Item(Ictr).SaveAsFile sPathName _
& .Item(Ictr).Parent
Next Ictr
End If
End With
DoEvents
Next oMessage
SaveAttachments = True
MsgBox "All Indepol Download files have been moved !!" & vbCrLf & vbCrLf & "It worked... Yahoo"
End Sub
答案 0 :(得分:1)
首先,如果在Outlook中运行VBA宏,则无需创建新的Outlook应用程序实例:
Set oOutlook = New Outlook.Application
相反,请使用defualt模块中提供的Application
属性。
Attachment
类的SaveAsFile方法接受一个字符串,该字符串代表保存附件的位置。确保在那里传递一个字符串。
一般情况下,我建议逐行调试代码,找出确切生成错误的属性或方法。您可能会发现Getting Started with VBA in Outlook 2010文章很有帮助。
答案 1 :(得分:1)
您正尝试将MailItem对象用作方法SaveAsFile
中的字符串,但错误。
我猜你想要将邮件主题包含在新文件名中:
.Item(Ictr).SaveAsFile sPathName _
& .Item(Ictr).Parent.Subject
如果您有多个附件,我会在其中添加初始文件名:
.Item(Ictr).SaveAsFile sPathName _
& .Item(Ictr).Parent.Subject
& .Item(Ictr).FileName
完整代码:
Sub OSP()
Dim oOutlook As Outlook.Application
Dim oNs As Outlook.NameSpace 'Main Outlook Today
Dim oFldrSb As Outlook.MAPIFolder 'Sub Folder in Outlook Today
Dim oFldrSbSb As Outlook.MAPIFolder 'Sub in Sub Folder
Dim oFldrSbSbsb As Outlook.MAPIFolder 'Sub in Sub in Sub Folder
Dim oMessage As Object
Dim sPathName As String
Dim oAttachment As Outlook.Attachment
Dim Ictr As Integer
Dim iAttachCnt As Integer
sPathName = "H:\Desktop\Toolkit Downloads\" 'My Folder Path where to save attachments
Set oOutlook = Application
Set oNs = oOutlook.GetNamespace("MAPI")
Set oFldrSb = oNs.Folders("Joe.Bloggs@test.co.uk")
Set oFldrSbSb = oFldrSb.Folders("Inbox")
Set oFldrSbSbsb = oFldrSbSb.Folders("Toolkit Downloads")
For Each oMessage In oFldrSbSbsb.items
With oMessage.Attachments
iAttachCnt = .Count
If iAttachCnt > 0 Then
For Ictr = 1 To iAttachCnt
.Item(Ictr).SaveAsFile sPathName _
& .Item(Ictr).Parent.Subject
& .Item(Ictr).FileName
Next Ictr
End If
End With
DoEvents
Next oMessage
SaveAttachments = True
MsgBox "All Indepol Download files have been moved !!" & vbCrLf & vbCrLf & "It worked... Yahoo"
End Sub