通过VBA获取Outlook中的传入电子邮件

时间:2012-12-24 11:39:12

标签: vba outlook-vba

我正在尝试通过outlook将传入的消息保存到我的本地文件系统。 我到目前为止的代码是:

Sub save_to_dir(Item As Outlook.MailItem)
 'the mail we want to process
Dim objItem As Outlook.MailItem
 'question for saving, use subject to save
Dim strPrompt As String, strname As String
 'variables for the replacement of illegal characters
Dim sreplace As String, mychar As Variant, strdate As String
 'put active mail in this object holder 

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


 'check if it's an email ... need to take a closer look cause
 'gives an error when something else (contact, task) is selected
 'because objItem is defined as a mailitem and code errors out
 'saving does work, if you take care that a mailitem is selected
 'before executing this code
 mypath = "c:\temp\outlook\"
If objItem.Class = olMail Then
    ' check on subject
    If objItem.Subject <> vbNullString Then
        strname = objItem.Subject
    Else
        strname = "No_Subject"
    End If
    strdate = objItem.ReceivedTime
     'define the character that will replace illegal characters
    sreplace = "_"
     'create an array to loop through illegal characters (saves lines)
    For Each mychar In Array("/", "\", ":", "?", Chr(34), "<", ">", "¦")
         'do the replacement for each character that's illegal
        strname = Replace(strname, mychar, sreplace)
        strdate = Replace(strdate, mychar, sreplace)
    Next mychar
     'Prompt the user for confirmation
    '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

此代码的问题在于,当您在电子邮件进入时在Outlook中选择了一个项目时,它会使用所选项目而不是收到的邮件

我如何收到收到的电子邮件?

由于

修改

调试此行后     设置objItem = Outlook.ActiveExplorer.Selection.Item(1)

我发现了那个     Outlook.ActiveExplorer.Selection.Item(1) 已经收到了当前的电子邮件,但是当我执行该行后我查看了objItem objItem的值是当前在outlook中选择的电子邮件,而不是收到的电子邮件。

有什么想法吗?

2 个答案:

答案 0 :(得分:0)

您可以在Outlook中设置“规则”来接收电子邮件,选择“运行脚本”,选择下面的子项

并将下面的子项放在thisoutlooksession模块的模块中

Sub testing(MyMail As MailItem)
 MyMail.SaveAs ' your path here
end sub

希望有所帮助

答案 1 :(得分:0)

可以在此处找到可以参考的好文章:http://www.outlookcode.com/article.aspx?id=62

我按照以下方式修改了样本:

Sub save_to_dir_test1(mymail As MailItem)
Dim strID As String
Dim objMail As Outlook.MailItem

strID = mymail.EntryID
Set objMail = Application.Session.GetItemFromID(strID)
mypath = "c:\temp\outlook\"
strdate = objMail.ReceivedTime
If objMail.Subject <> vbNullString Then
        strname = objMail.Subject
   Else
        strname = "No_Subject"
End If
sreplace = "_"
'create an array to loop through illegal characters (saves lines)
For Each mychar In Array("/", "\", ":", "?", Chr(34), "<", ">", "¦")
'do the replacement for each character that's illegal
   strname = Replace(strname, mychar, sreplace)
   strdate = Replace(strdate, mychar, sreplace)
Next mychar
objMail.SaveAs mypath & strname & "--" & strdate & ".msg", olMSG

Set objMail = Nothing
End Sub