Automating Outlook Message Saves

[mpm32]

Hi,

I am trying to save outlook messages to a network drive. The messages are in a shared mailbox folder, not my main outlook account. I have found a script and I have set up a rule for it to run from. It runs fine but only on a selected message or a group. I would like it to run when the new email comes in or on new emails when I open outlook even if I do not have that mailbox selected. (I know it will only run if outlook is opened)

I suspect that it has something to do with the line "For Each objItem In ActiveExplorer.Selection
Set oMail = objItem"

Thanks in advance for your help.


Option Explicit
Public Sub SaveMessageAsMsg(itm As Outlook.MailItem)
Dim oMail As Outlook.MailItem
Dim objItem As Object
Dim sPath As String
Dim dtDate As Date
Dim sName As String
Dim enviro As String

enviro = CStr(Environ("USERPROFILE"))
For Each objItem In Application.ActiveExplorer.Selection
Set oMail = objItem

sName = oMail.Subject
ReplaceCharsForFileName sName, "_"

dtDate = oMail.ReceivedTime
sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
vbUseSystem) & Format(dtDate, "-hhnnss", _
vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName & ".msg"

sPath = "\\Pxx.xxx.xxx\SHxxx\SHARED-DATA\D-SHL1-AR-SHARED-SERVICES\EIPP Reports\Tracking Reports\"
Debug.Print sPath & sName
oMail.SaveAs sPath & sName, olMSG
Next
End Sub

Private Sub ReplaceCharsForFileName(sName As String, _
sChr As String _
)
sName = Replace(sName, "/", sChr)
sName = Replace(sName, "\", sChr)
sName = Replace(sName, ":", sChr)
sName = Replace(sName, "?", sChr)
sName = Replace(sName, Chr(34), sChr)
sName = Replace(sName, "<", sChr)
sName = Replace(sName, ">", sChr)
sName = Replace(sName, "|", sChr)
End Sub

 

[kjv1611]

If you want it to run on anything in the Inbox for a certain Mailbox, then you'll want to specify that. You're right with your hunch, I think. ActiveExplorer.Selection implies what you have currently selected. You want to change that to refer to your Inbox instead. There are oodles of references on the web showing how to loop through items in an Outlook folder, so I'd search for that, and go from there.

"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57