下载作为Outlook项目的Outlook附件

Question

如何自动下载作为展望项目的附件？

我尝试使用此vba脚本下载，但它不适用于Outlook项目。它适用于.txt或任何其他类型的附件。

Public Sub Savisk(MItem As Outlook.MailItem)
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String
sSaveFolder = "D:\userdata\sanakkay\Desktop\"
For Each oAttachment In MItem.Attachments
oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
Next
End Sub

Answer 1

Outlook项目可能被命名/包含在文件名中具有非法字符的主题。

例如

中的冒号字符

  

任务名称：KM_CEM_GY

至少有两种标准方法可以解决这个问题。

Outlook 2010 VBA How to save message including attachment

Private Sub ReplaceCharsForFileName(sName As String, sChr As String)
    sName = Replace(sName, "'", sChr)
    sName = Replace(sName, "*", sChr)
    sName = Replace(sName, "/", sChr)
    sName = Replace(sName, "\", sChr)
    sName = Replace(sName, ":", sChr)
    sName = Replace(sName, "?", sChr)
    sName = Replace(sName, Chr(34), sChr)
    sName = Replace(sName, "<", sChr)
    sName = Replace(sName, ">", sChr)
    sName = Replace(sName, "|", sChr)
End Sub

VBA dialog boxes automatically answer solution

Function StripIllegalChar(StrInput)
    Dim RegX            As Object

    Set RegX = CreateObject("vbscript.regexp")

    RegX.Pattern = "[\" & Chr(34) & "\!\@\#\$\%\^\&\*\(\)\=\+\|\[\]\{\}\`\'\;\:\<\>\?\/\,]"
    RegX.IgnoreCase = True
    RegX.Global = True

    StripIllegalChar = RegX.Replace(StrInput, "")

ExitFunction:
    Set RegX = Nothing

End Function

Answer 2

如果要从Outlook下载附件，请尝试此操作。 Private Sub GetAttachments（）

Dim ns As Namespace
Dim Inbox As Outlook.MAPIFolder
Dim Item As Object
Dim Atmt As Outlook.Attachment
Dim FileName As String

Set ns = GetNamespace("MAPI")
Set Inbox = ns.Folders("MailboxName").Folders("Inbox")

If Inbox.Items.Count = 0 Then
    MsgBox "There are no messages in the Inbox.", vbInformation, _
            "Nothing Found"
    Exit Sub
End If

For Each Item In Inbox.Items
    For Each Atmt In Item.Attachments
        If Atmt.Type = 1 And InStr(Atmt, "xlsx") > 0 Then
            FileName = "C:\attachments\" & Atmt.FileName
            Atmt.SaveAsFile FileName
        End If
    Next Atmt
Next Item

End Sub 设置对MS Outlook的引用并记住，＆＃34; MailboxName＆＃34;是你的电子邮件地址。