Outlook不通过VBA保存附件

时间:2018-06-15 16:52:27

标签: excel vba excel-vba outlook

我有一些VBA代码在我的机器上实际工作正常,但不是我的客户端。挂断的地方是打开电子邮件附件并将其保存到计算机上的某个位置。

For Each nm in file_names 'file_names is just an array of strings
    found_file=False
    curr_date=CDate("1-1-9999")
    For Each olItem in olItems
        If olItem.ReceivedTime < curr_date and olItem.SenderEmailAddress=email and TypeName(olItem)="MailItem" then
            Set olAttach=olItem.attachments.Item(1)
            If not olAttach is Nothing then
                If olAttach.Filename Like nm & ".*" then
                    found_file=True
                    curr_date=olItem.ReceivedTime
                end if
            end if
        end if
    Next
    If found_file then
        olAttach.SaveAsFile pth & olAttach.Filename 'errors out here
        ...

错误消息为Cannot save the attachment,但未指明原因。

我试图让他启用所有宏,关闭受保护的视图选项,重启excel和outlook,尝试不同的文件位置保存到,文件路径与文件名连接时不会发生双重\我确定他没有使用Mac。显然其中一个附件文件确实打开了,但它只是拒绝保存。

1 个答案:

答案 0 :(得分:0)

看起来传递给SaveAsFile方法的文件路径/名称字符串不是格式良好的路径。例如,FileName可能包含禁用的符号等。尝试使用以下代码作为测试:

Sub SaveAttachment()
Dim myInspector As Outlook.Inspector
Dim myItem As Outlook.MailItem
Dim myAttachments As Outlook.Attachments

Set myInspector = Application.ActiveInspector
If Not TypeName(myInspector) = "Nothing" Then
    If TypeName(myInspector.CurrentItem) = "MailItem" Then
        Set myItem = myInspector.CurrentItem
        Set myAttachments = myItem.Attachments
        'Prompt the user for confirmation
        Dim strPrompt As String
        strPrompt = "Are you sure you want to save the first attachment in the current item to the Documents folder? If a file with the same name already exists in the destination folder, it will be overwritten with this copy of the file."
        If MsgBox(strPrompt, vbYesNo + vbQuestion) = vbYes Then
            myAttachments.Item(1).SaveAsFile Environ("HOMEPATH") & "\My Documents\" & _
            myAttachments.Item(1).DisplayName
        End If
    Else
        MsgBox "The item is of the wrong type."
    End If
End If
End Sub