自动转发outlook的邮件

在MSDN上查到了一些代码，稍作修改，如下所示。（当然，和Excel上使用Vba的方法差不多）
Option Explicit

Public WithEvents myOlItems As Outlook.Items
Public Sub Application_Startup()

   ' Reference the items in the Inbox. Because myOlItems is declared
   ' "WithEvents" the ItemAdd event will fire below.
   Set myOlItems = Outlook.Session.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub myOlItems_ItemAdd(ByVal Item As Object)
Dim myForward As Outlook.MailItem

If TypeName(Item) = "MailItem" Then

' Forward the item just received
Set myForward = Item.Forward

' Address the message
myForward.Recipients.Add ("yourname@gmail.com")

' Send it
myForward.Send

End If
End Sub

不过好像没有很即时的感觉，gmail那边得很长时间才能收到，不知道是不是我们公司邮件服务器的问题。

另外，作为一个记录，下边附上我的outlook中的マクロ。
其中包含了在发送邮件的时候检测附件，同时发送给我的gmail一份。另外还有网上拷的转发所有邮件的代码，暂时还有些问题(发送的时候有提示），有时间想办法解决一下。

如果长时间不使用oulook的话，可以联上公司的邮件服务器，对自己账户规则，新邮件一律转发，也可以达到自动转发的功能。

Option Explicit

Public WithEvents myOlItemsInbox As Outlook.Items

Public Sub FwdToGmail()

    Dim objApp As Outlook.Application
    Dim objNameSpace As Outlook.NameSpace
    Dim objMAPIFolder As Outlook.MAPIFolder
    Dim objMailItem As Outlook.MailItem
    Dim objFwdItem As Outlook.MailItem

    Set objApp = New Outlook.Application
     '' DisablePrompt (objApp)
    Set objNameSpace = objApp.GetNamespace(Type:="MAPI")
    Set objMAPIFolder = _
        objNameSpace.GetDefaultFolder(FolderType:=olFolderInbox)

    For Each objMailItem In objMAPIFolder.Items

        Set objFwdItem = objMailItem.Forward

        objFwdItem.Recipients.Add ("netkyo@gmail.com")

        objFwdItem.Send

Next objMailItem

End Sub

Function DisablePrompt(ByRef object)
Dim tmp
Set tmp = CreateObject("addinexpress.outlooksecuritymanager")
tmp.ConnectTo (object)
tmp.DisableOOMWarnings = True
tmp.DisableCDOWarnings = True
tmp.DisableSMAPIWarnings = True
End Function

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

    Dim lngres As Long
    If InStr(1, UCase(Item.Body), "添付ファイル") <> 0 Then
      If Item.Attachments.Count = 0 Then
            lngres = MsgBox("メール内容中で「添付ファイル」を見つけましたが、添付ファイルが無い、送信しますか？", _
            vbYesNo + vbDefaultButton2 + vbQuestion, "Warning...")
          If lngres = vbNo Then
             Cancel = True
             Exit Sub
          End If
      End If
    End If

''Sendの時、Gmailに発送します。
Item.Recipients.Add ("netkyo@gmail.com")
End Sub

Public Sub Application_Startup()

   ' Reference the items in the Inbox. Because myOlItems is declared
   ' "WithEvents" the ItemAdd event will fire below.
   Set myOlItemsInbox = Outlook.Session.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub myOlItemsSent_ItemAdd(ByVal Item As Object)
   Dim myForward As Outlook.MailItem
   If TypeName(Item) = "MailItem" Then
         ' Forward the item just received
         Set myForward = Item.Forward
         ' Address the message
         myForward.Recipients.Add ("netkyo@gmail.com")
         ' Send it
         myForward.Send
      End If
End Sub

来源：https://www.cnblogs.com/xioxu/archive/2007/06/29/800121.html

标签

outlook

sub