VBA Outlook运行时错误'':对象不支持此属性或方法

时间:2017-07-04 15:12:23

标签: vba outlook outlook-vba

我正在尝试运行此宏来将电子邮件附件从我的收件箱中的文件夹(称为工具包下载)移动到桌面上的文件夹中并重命名附件。

我得到了

  

运行时错误'':对象不支持此属性或方法

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

2 个答案:

答案 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