2012-04-20 57 views
1

我正尝试创建一个VBA宏,该电子邮件附件根据电子邮件地址保存到文件夹。例如,如果我通过[email protected]收到附件并附上电子邮件,我想将该附件保存到目录 \ server \ home \ joey ,或者如果我从[email protected]收到该附件,则附件应保存在 \ server \ home \ steve。将电子邮件附件保存到网络位置

最后,我想发送一个回复电子邮件与保存的文件的名称。我发现一些代码几乎可以做我想做的事情,但我很难修改它。这一切都是在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 

回答

1

这是你在想什么? (UNTESTED

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 "[email protected]" 
       SaveAsName = mypath & "joey\" & strSubj & "--" & strdate & ".msg" 
      Case "[email protected]" 
       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 
+0

这个作品感谢您的帮助。 – 2012-04-23 09:56:00

0

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

相关问题