Automatically forward outlook emails

I found someCode, As shown in the following figure. (Of course, it is similar to using VBA in Excel)
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 already ed
Set myforward = item. Forward

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

'Send it
Myforward. Send

End if
End sub

However, it seems that there is no real-time feeling. It takes a long time for Gmail to receive it. I don't know if it is a problem with our company's email server.

In addition, as a record, the following is an example of my outlook.
This includes checking attachments when sending emails and sending them to my Gmail. In addition, the Code for copying and forwarding all emails on the Internet is also available, and there are still some problems (there is a prompt when sending). You have time to find a solution.

If you do not use oulook for a long time, you can connect to the company's email server to forward all new emails to your account rules, or enable automatic forwarding.

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 too many tasks? ",_
Vbyesno + vbdefaultbutton2 + vbquestion, "warning ...")
If lngres = vbno then
Cancel = true
Exit sub
End if
End if
End if

''When sending the email, Gmail cannot send the email.
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 ed
set myforward = item. forward
'address the message
myforward. recipients. add ("netkyo@gmail.com")
'send it
myforward. send
end if
end sub