自动转发outlook的邮件

houbin

　　在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