This is a followup to a previous question I had asked. Thank you to the community for your help with that.
I'm trying to create WithEvents code for the first time to check a folder for new items. Eventual plan is to use the ItemsAdd event to trigger a bunch of other processing, but for now, just trying to save it to a folder and not getting that far.
When I run the Application_Startup code below, the immediate window shows that I've found the right clntFldrItms. Problem is, if I then drag an item into the folder in question, the ItemAdd macro doesn't fire. When I try to add a watch for clntFldrItms, the variable isn't set to anything. It looks like as soon as the Application_Startup sub finishes, the assignment stops.
All code is in the ThisOutlookSession object.
Could this be because I'm working with an SMTP email address (rather than Exchange, for example)?
Thanks again for your help.
EDIT Adding my response to Eugene's comment. I noticed that when I open the editor and step into the Application_Startup sub, clntFldrItms is properly assigned, even before I get to the Set clntFldrItms = clntFldr.Items line. As soon as I finish stepping through, it's gone again. I can't step into the ItemAdd sub, but when I step into other code clntFldrItms is Nothing.
FINAL EDIT Sorry, I realize I forgot to close this off. I wasn't able to solve the problem per se, but I realized it was due to my SMTP account. When I tried it at work with Exchange, it worked. It seems that the event doesn't fire unless I'm working in Exchange.
Option Explicit
Public WithEvents clntFldrItms As Outlook.Items
Private Sub Application_Startup()
Dim clntFldr As MAPIFolder
Set clntFldr = Application.Session.GetDefaultFolder(olFolderSentMail).Folders("Client Emails")
Set clntFldrItms = clntFldr.Items
Set clntFldr = Nothing
Debug.Print clntFldrItms.item(1).Subject
End Sub
Private Sub clntFldrItms_ItemAdd(ByVal item As Object)
Dim bChar As String
bChar = "\/:*?™""® <>|.&##_+`©~;-+=^$!,'" & Chr(34)
Dim saveName As String
If item.Class = olMail Then
saveName = item.Subject
For x = 1 To Len(bChar)
saveName = Replace(saveName, Mid(bChar, x, 1), "-")
Next x
item.SaveAs "C:\Users\User\Google Drive\8 - VBA work\Preparation for Assisted Responder\Sent Messages Folder\" & _
saveName & ".msg", olMSG
End If
End Sub
Try to set a breakpoint in the ItemAdd event handler and check out the clntFldrItms object there when the breakpoint is hit.
Be aware, the ItemAdd event is not fired when multiple items were added at the same time (more than 16 - this is a well-known issue in Outlook).
You may find the Getting Started with VBA in Outlook 2010 article hellpful.
EDIT The clntFldrItms is set because the Startup event handler is run when you start Outlook. So, the object is initialized at startup behind the scene.
Related
I've code in the "ThisOutlookSession" module.
Application_ItemSend works, events are triggered when sending mail.
Application_Startup runs when I initiate it manually after Outlook has been opened - not upon startup.
Making the sub private makes no difference - neither does making the variables public.
I have macro settings on "Enable all macros" in the Trust Center.
I'm on Outlook 2016 on a PC running Windows 10 Enterprise.
I have researched the issue intensively.
Option Explicit
Dim add_str As String
Public Sub Application_Startup()
Dim olNs As Outlook.NameSpace
Dim Folder As Outlook.MAPIFolder
Dim SubFolder As Outlook.MAPIFolder
Dim Item As Object
Set olNs = Application.GetNamespace("MAPI")
Set Folder = olNs.Folders("albrobin#workmail.com").Folders("WORKFLOW").Folders("Reporting")
For Each SubFolder In Folder.Folders
If SubFolder.items.Restrict("[UnRead] = True").Count > 0 Then
For Each Item In SubFolder.items
Item.UnRead = False
Next
End If
Next
End Sub
Public Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
If TypeName(Item) <> "MailItem" Then
Exit Sub
End If
If Item.Subject Like "RE: *" _
Or Item.Subject Like "AW: *" _
Or Item.Subject Like "FW: *" Then
Exit Sub
End If
UserForm1.Show
If add_str = "[URGENT] " Then
Item.Importance = olImportanceHigh
End If
Item.Subject = add_str & Item.Subject
add_str = vbNullString
End Sub
Public Sub routine(str_ As String)
add_str = Replace(str_, vbCrLf, " ")
add_str = "[" & add_str & "] "
End Sub
Sub show_form1()
UserForm1.Show
End Sub
I tested your code and I’ve ran into the same problem.
I have solved this problem by restarting my PC and adding the Public Sub Application_Quit() method.
There seems to be a flag in outlook which checks for VBA code. If it can't find any it sets the registry value (HKEY_CURRENT_USER\Software\Microsoft\Office\XX.0\Outlook\LoadMacroProviderOnBoot) to 0 every time it closes. It doesn't seem to be setup so that it detects when code is added by copying the OTM file.
I have discovered 2 scenarios (there may be more) which cause the flag to be set causing outlook to change the registry value to 1 on close.
If any macro is run
The visual basic editor is opened.
The issue arose in my situation when I try to roll out the VBA code to a new PC with no existing VBA code.
I use a batch script to roll out my VBA code to other machines and to fix it I simply added a REG ADD command to the bat file after the code is copied to the machine which sets the key to 1.
REG ADD HKCU\Software\Microsoft\Office\XX.0\Outlook /v LoadMacroProviderOnBoot /t REG_DWORD /d 1 /f
You need to change “XX.0” to the version of office you are dealing with. Check the registry to find out.
This seems to force Outlook to check for VBA code when it starts.
(Thanks to Sergik718 on Microsoft TechNet forums for pointing out that changing this registry entry helps.)
Was experiencing same problem with Application_Startup() procedure not firing after a system reload and restore of my VBAProject. Checked macro settings, digitally signed the project - no luck. Received no button to Enable VBA during startup, like in Office 2010. VBA would function, but required me to manually fire the Application_Startup() procedure.
Tried creating a new, temporary "Private Application_Startup()" procedure, but no joy.
I deleted "Public" statement that preceded the Application_Startup() declaration. Saved, closed VBA and Outlook. Re-opened and suddenly it started working. Have restored the "Public", saved, re-opened, and it now seems to work properly. No explanation.
Had a similar problem. Application_Startup didn't trigger on restarting Outlook and hence my changes in the function didn't load. The reason Application_Startup didn't trigger was because I had another program holding a reference open to Outlook
I know virtually nothing about VBA but am attempting to learn. I am trying to assist a blind client who gets messages from a specific agency he uses to get freelance engagements. These messages have to be responded to almost instantly by clicking on an "Accept" link in the message or there is no chance of getting the job. Since he uses a screen reader this complicates matters.
I have tried to adapt what I've found at stackoverflow to take the message on receipt, triggered by a message rule, to invoke VBA code to dig out the URL and immediately activate it.
Sub LaunchURL(itm As MailItem)
Dim MsgBody As String
Dim AllMsgLines
Dim IndividualLine
Dim AllLineWords
Dim SingleWord
Dim MboxReply
MsgBody = itm.Body
AllMsgLines = Split(MsgBody, vbCrLf)
For Each IndividualLine In AllMsgLines
AllLineWords = Split(IndividualLine, " ")
For Each SingleWord In AllLineWords
If SingleWord Like "http://*" Then
MboxReply = MessageBox.Show("I've found a URL", "LaunchURL Script", MessageBoxButtons.OKCancel, MessageBoxIcon.Asterisk)
Set itm = Nothing
Exit Sub
End If
Next SingleWord
Next IndividualLine
Set itm = Nothing
End Sub
Private Sub TestLaunchURL()
Dim currItem As MailItem
Set currItem = ActiveInspector.CurrentItem
LaunchURL currItem
End Sub
The code above is what I've been experimenting with. I will actually replace the message box either with:
Shell ("C:\Program Files\Internet Explorer\IEXPLORE.EXE" & " " & SingleWord)
or
FollowHyperlink SingleWord
When I run this I get "Runtime Error 91: Object variable or With block variable not set". I've tried stepping into the code and from what I can tell the problem originates at the SET statement in the TestLaunchURL subroutine.
I am trying to snag the message I currently have focus on in my Outlook inbox and parse it apart for the first instance of "http://", at least at the moment.
Also, what would I expect to be getting back in "SingleWord" if I have a URL that has click-through text that is shown to the user tied to the actual URL itself? I might be able to exploit that to look for the word "Accept" just ahead of the URL itself were "Accept" the click through text.
I would like to be able to find out what time/date emails received in microsoft outlook were read.
I can't see that the information is saved by Outlook. Nor does it appear the LastModificationTime reflects this either - it isn't updated when an item is marked as read (at least in Outlook 2007)
Assuming this is correct, I have decided to store this information in the future, and created a userproperty to reflect this. I've hooked the mailitem.PropertyChange event handler with the following code, but it's not a very universal solution - I'll have to put the code into every Outlook app I use. Is there a more efficient way of doing it?
This code in placed in the ThisOutlookSession module (and Outlook restarted)
Private WithEvents objExplorer As Outlook.Explorer
Private WithEvents myItem As Outlook.MailItem
Private Sub Application_Startup()
Set objExplorer = Application.ActiveExplorer
End Sub
Private Sub objExplorer_SelectionChange()
If objExplorer.CurrentFolder.DefaultItemType = olMailItem Then
If objExplorer.Selection.count > 0 Then
Set myItem = objExplorer.Selection(1)
End If
End If
End Sub
Private Sub myItem_PropertyChange(ByVal Name As String)
' Debug.Print Name & "=" & myItem.UnRead
If Name = "UnRead" And myItem.UnRead = False Then
Dim myProperty As Outlook.UserProperty
Set myProperty = myItem.UserProperties("ReadTime")
If (myProperty Is Nothing) Then Set myProperty = myItem.UserProperties.Add("ReadTime", olNumber)
myProperty.Value = Now()
myItem.Save
' Debug.Print Format(myItem.UserProperties("ReadTime"), "hh:mm:ss dd/mm/yy")
ElseIf Name = "UnRead" And myItem.UnRead = True Then
myItem.UserProperties("ReadTime").Delete
End If
' Debug.Print
End Sub
Thanks
You are right, the Outlook object model doesn't provide anything about the Read status (the time when it was marked as read).
VBA is not designed for distributing on multiple PCs. You need to develop an Outlook add-in instead. That's exactly for what they were introduced. See Walkthrough: Creating Your First Application-Level Add-in for Outlook to get started.
You cannot do that - strictly speaking, read/unread state is not even part of the message: it is stored separately. And Exchange Public Folders store stores that state on the per-user basis.
If you set the user property, it will not be persisted unless you call Save, but that will change the last modification time.
I use a outlook rule to process incoming mail via a VBA macro.
in the vba various actions are triggerd to process attachments of the incoming mail.
The problem is, there somethimes is a stack of e-mails that need to be processed.
I cant seem to find a way how to trigger the one by one.
I want to wait a few seconds before processing the next mail, if there is a stack.
Putting a sleep method in the macro doesnt seem to have effect. the rule doesnt seem to wait for the previous message to be done.
My method i something like:
Is there a way to accomplish this behaviour?
Private Sub ProcessMail(ByVal Item As Object)
Dim objNS As Outlook.NameSpace
Set objNS = GetNamespace("MAPI")
If TypeOf Item Is Outlook.MailItem Then
Dim Msg As Outlook.MailItem
DoProcessingMethod
End If
End If
End Sub
Putting a wait or sleep in the method doesnt cause it to be processed one by one.
GD Arnold,
You could indeed use the ItemAdd option as per #Brett's answer.
I use a similar process to automatically upload received data (as attachment in an email) and upload this to a MySQL database. The action is triggered by the ItemAdd method and mails are checked one-by-one.
Simplified instructions:
Add a Class to your VBA code named "EventClassModule"
In your class, type
Public WithEvents dItems As Outlook.Items
In your ThisOutlookSession make a sub that registers the event_handler:
Sub Register_Event_Handler()
Set myClass.dItems = Outlook.Items
End Sub
In your ThisOutlookSession make a sub that handles the ItemAdd event as below:
Private Sub dItems_ItemAdd(ByVal newItem As Object)
On Error GoTo ErrorHandler
Dim msg As Outlook.MailItem
If newItem.Class = olMail Then
Set msg = newItem
'Do something with the msg item, check rules, check subject, check whatever
'This will process messages when the arrive in your mailbox one by one.
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
These steps should provide you with a sub that is triggered when a new mail arrives.
You could then call a function/sub like below.
The below sub runs all rules based on an optional ruleSet variable, it checks the rule.Name against the ruleSet and if the ruleSet string exists in the rule.Name then it executes some code. This way you can have multiple rules and only execute some of them based on which 'ruleSet' they are part of. You can define that by altering their name.
It's a refinement of the 'Run Rules' option in Outlook.
Some of this code came frome here: Setting VBA to read personal inbox
Sub runRules(Optional ruleSet As String)
Dim olStore As Outlook.Store
Dim myRules As Outlook.Rules
Dim tmpInbox As Outlook.Folder
Dim tmpSent As Outlook.Folder
Dim rl As Outlook.Rule
'On Error Resume Next
'toTmpBox (ruleSet)
' get default store (where rules live)
Set olStore = Application.Session.DefaultStore
With olStore
Set tmpInbox = .GetDefaultFolder(olFolderInbox) '.Folders("tmpInbox")
Set tmpSent = .GetDefaultFolder(olFolderSentMail) '.Folders("tmpSentBox")
End With
' get rules
Set myRules = olStore.GetRules
' iterate through all the rules
For Each rl In myRules
Debug.Print rl.Conditions.Body.Enabled & " " & rl.Conditions.Body.Text
If InStr(LCase(rl.Name), ruleSet) > 0 And (rl.Enabled) Then
rl.Execute ShowProgress:=True, Folder:=tmpInbox
If ruleSet = "autorun" Then
rl.Execute ShowProgress:=True, Folder:=olStore.GetDefaultFolder(olFolderSentMail)
End If
ruleList = ruleList & vbCrLf & rl.Name
End If
Next
' tell the user what you did
ruleList = "These rules were executed " & _
vbCrLf & ruleList
MsgBox ruleList, vbInformation, "Macro: RunMyRules"
CleanUp:
Set olStore = Nothing
Set tmpInbox = Nothing
Set tmpSent = Nothing
Set rl = Nothing
Set myRules = Nothing
End Sub
I have come across a similar problem. In my case my tool would run at regular time interval and each time I had to capture new emails only. Now new emails could be one or multiple. the solution I found was as given below.
Each time the tool would run. it will capture the new emails and just mark a simple ',' or '|' anything of your choice at the end of the subject in such a way that no one will notice. Now next time when the tool runs it checks if the emails received for the entire day or two (based on your requirements) has those markers or not.
This solution works if the email communication is one way. If we use these email for chain emails then their is another solution.
Here you will have to save the time max time of emails captured in the last run. Now each time you run you just have to run it for the entire day and put an if statement that is should be greater then time last captured.
Now to store the max time you might need to create a folder and an email. The email can help you to store the each time the run happens
item.subject = maxtime
item.save
I'm trying to debug an Outlook 2007 VBA script that's fired by a rule. I've set a breakpoint in the script but it doesn't get hit.
The script is actually a Sub in the ThisOutlookSession object.
When I run the rule on a specified folder nothing seems to happen.
What am I doing wrong?
Update:
I've added a MsgBox "Processing: " & mailItem.Subject to the script and that pops up just fine when I run the rule. However I can't seem to get the script to stop on breakpoints.
I think you may not be doing anything wrong, because I have experienced exactly the same behaviour.
However, in order to debug your VBA, I suggest that you create a macro (via the Tools|Macro|Macros menu) that calls your script function with a test e-mail item that you create in the macro.
Maybe something like this:
Sub TestScript()
Dim testMail As MailItem
Set testMail = Application.CreateItem(olMailItem)
testMail.Subject = "Test subject"
testMail.Body = "Test body"
Project1.ThisOutlookSession.YourScriptForDebugging testMail
End Sub
This way you can "Step Into" the macro via that Macro dialog again, and do all the debugging you need. It solved my problem, anyway.
Any existing item can be used to test code that requires one.
Sub passOpenItem()
'first open an item
codeRequiringItemParameter ActiveInspector.CurrentItem
End Sub
Sub passSeletion()
'first select an item
codeRequiringItemParameter ActiveExplorer.Selection(1)
End Sub
Sub codeRequiringItemParameter(itm As Object)
Debug.Print "TypeName: " & TypeName(itm)
Debug.Print "Class...: " & itm.Class
End Sub