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

我正在尝试创建一个VBA宏，根据电子邮件地址将电子邮件附件保存到文件夹中。例如，如果我从以下地址接收并发送带有附件的电子邮件：joey@me.com我想把附件保存到目录中 \服务器\home\joey 或者如果我是从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

Const mypath=“\\server\Home\joe”
将_保存到_v（）
将对象对象设置为Outlook.MailItem
Dim strPrompt作为字符串，strname作为字符串
Dim sreplace作为字符串，mychar作为变量，strdate作为字符串
设置objItem=Outlook.ActiveExplorer.Selection.item（1）
如果objItem.Class=olMail，则
如果是objItem.Subject vbNullString，则
strname=objItem.Subject
其他的
strname=“无主题”
如果结束
strdate=objItem.ReceivedTime
sreplace=“\”
对于数组（“/”、“\”、“：”、“？”、Chr（34）、“、”、“|”）中的每个mychar
strname=Replace（strname、mychar、sreplace）
strdate=Replace（strdate，mychar，sreplace）
下一个mychar
strcompt=“是否确实要保存该项目？”
如果MsgBox（strcompt，vbYesNo+vbQuestion）=vbYes，则
objItem.SaveAs mypath&strname&“--”&strdate&“.msg”，olMSG
其他的
MsgBox“您选择不保存。”
如果结束
如果结束
端接头

这就是您要尝试的吗？（未经测试）

选项显式
Const mypath=“\\server\Home\”
将_保存到_v（）
将对象对象设置为Outlook.MailItem
Dim STRCOMPT作为字符串，strname作为字符串，strSubj作为字符串，strdate作为字符串
Dim SaveAsName为字符串，SREEPLACE为字符串
Dim mychar作为变体
设置objItem=Outlook.ActiveExplorer.Selection.Item（1）
如果objItem.Class=olMail，则
如果是objItem.Subject vbNullString，则
strSubj=objItem.Subject
其他的
strSubj=“没有主题”
如果结束
strdate=objItem.ReceivedTime
sreplace=“\”
对于数组（“/”、“\”、“：”、“？”、Chr（34）、“、”、“|”）中的每个mychar
strSubj=Replace（strSubj、mychar、sreplace）
strdate=Replace（strdate，mychar，sreplace）
下一个mychar
strname=objItem.SenderEmailAddress
strcompt=“是否确实要保存该项目？”
如果MsgBox（strcompt，vbYesNo+vbQuestion）=vbYes，则
选择案例strname
案例”joey@me.com"
SaveAsName=mypath&“joey\”&strSubj&“--”&strdate&“.msg”
案例”steve@me.com"
SaveAsName=mypath&“steve\”&strSubj&“--”&strdate&“.msg”
结束选择
objItem.SaveAs SaveAsName，olMSG
其他的
MsgBox“您选择不保存。”
如果结束
如果结束
端接头

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

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