将电子邮件附件保存到网络位置答案

【问题标题】：Save Email Attachments to a Network location将电子邮件附件保存到网络位置
【发布时间】：2020-06-24 04:52:14
【问题描述】：

我正在尝试创建一个 VBA 宏，根据电子邮件地址将电子邮件附件保存到文件夹。例如，如果我收到来自 joey@me.com 的附件并通过电子邮件发送，我想将该附件保存到目录中 \服务器\家庭\乔伊或者如果我是从 steve@me.com 收到的，附件应该保存在 \服务器\家庭\史蒂夫。

最后我想发送一封回复电子邮件，其中包含已保存文件的名称。我发现一些代码几乎可以满足我的要求，但我很难修改它。这一切都在 Outlook 2010 中完成。这就是我目前所拥有的。任何帮助将不胜感激

Const mypath = "\\server\Home\joe\"
Sub save_to_v()

    Dim objItem As Outlook.MailItem
    Dim strPrompt As String, strname As String
    Dim sreplace As String, mychar As Variant, strdate As String
    Set objItem = Outlook.ActiveExplorer.Selection.item(1)
    If objItem.Class = olMail Then

        If objItem.Subject <> vbNullString Then
            strname = objItem.Subject
        Else
            strname = "No_Subject"
        End If
        strdate = objItem.ReceivedTime

        sreplace = "_"

        For Each mychar In Array("/", "\", ":", "?", Chr(34), "<", ">", "|")

            strname = Replace(strname, mychar, sreplace)
            strdate = Replace(strdate, mychar, sreplace)
        Next mychar

        strPrompt = "Are you sure you want to save the item?"
        If MsgBox(strPrompt, vbYesNo + vbQuestion) = vbYes Then
            objItem.SaveAs mypath & strname & "--" & strdate & ".msg", olMSG
        Else
            MsgBox "You chose not to save."
        End If
    End If
End Sub

【问题讨论】：

标签： vba outlook

【解决方案1】：

这是你正在尝试的吗？（未测试）

Option Explicit

Const mypath = "\\server\Home\"

Sub save_to_v()

    Dim objItem As Outlook.MailItem
    Dim strPrompt As String, strname As String, strSubj As String, strdate As String
    Dim SaveAsName As String, sreplace As String
    Dim mychar As Variant

    Set objItem = Outlook.ActiveExplorer.Selection.Item(1)

    If objItem.Class = olMail Then

        If objItem.Subject <> vbNullString Then
            strSubj = objItem.Subject
        Else
            strSubj = "No_Subject"
        End If

        strdate = objItem.ReceivedTime

        sreplace = "_"

        For Each mychar In Array("/", "\", ":", "?", Chr(34), "<", ">", "|")
            strSubj = Replace(strSubj, mychar, sreplace)
            strdate = Replace(strdate, mychar, sreplace)
        Next mychar

        strname = objItem.SenderEmailAddress

        strPrompt = "Are you sure you want to save the item?"

        If MsgBox(strPrompt, vbYesNo + vbQuestion) = vbYes Then
            Select Case strname
            Case "joey@me.com"
                SaveAsName = mypath & "joey\" & strSubj & "--" & strdate & ".msg"
            Case "steve@me.com"
                SaveAsName = mypath & "steve\" & strSubj & "--" & strdate & ".msg"
            End Select

            objItem.SaveAs SaveAsName, olMSG
        Else
            MsgBox "You chose not to save."
        End If
    End If
End Sub

【讨论】：

【解决方案2】：

它永远不会起作用。由于 Outlook 2010 没有将任何 msg 文件保存到网络驱动器，因此只有本地驱动器正在工作！如 M$ 的文档中所述并由我测试。具有固定路径和文件名的简单测试。本地 c:\ 有效。 UNC 或 L 中的网络驱动器：不起作用！！！！

【讨论】：