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.
Related
I found this code on stack overflow and I am trying to use it to open Internet Explorer with a link in the email that comes from a specific address (I created a rule for this).
When I try to run it I receive the following error: "The script doesn't exist or is invalid.". I am using Microsoft Outlook 2010.
Sub LaunchURL(itm As MailItem)
Dim bodyString As String
Dim bodyStringSplitLine
Dim bodyStringSplitWord
Dim splitLine
Dim splitWord
bodyString = itm.Body
bodyStringSplitLine = Split(bodyString, vbCrLf)
For Each splitLine In bodyStringSplitLine
bodyStringSplitWord = Split(splitLine, " ")
For Each splitWord In bodyStringSplitWord
If Left(splitWord, 7) = "http://" Then
Shell ("C:\Program Files (x86)\Internet Explorer\iexplore.exe" & " " & splitWord)
End If
Next
Next
Set itm = Nothing
End Sub
Private Sub test()
Dim currItem As MailItem
Set currItem = ActiveInspector.CurrentItem
LaunchURL currItem
End Sub
First of all, the script is wrong. You try to open each word from the message body in the web browser. You need to find a real URL instead.
You need to use the HTMLBody property of Outlook items to get a string representing the HTML body of the specified item. Then you can look for the <a href= tags. Only in that case you can get the URL and run it in the browser.
Also, as a workaround, you may consider using the Word object model. The WordEditor property of the Inspector class returns an instance of the Document class which represents the message body. Then you can use the Hyperlinks property of the Document class which returns a Hyperlinks collection that represents all the hyperlinks in the specified document. For example:
For Each aHyperlink In document.Hyperlinks
If InStr(LCase(aHyperlink.Address), "microsoft") <> 0 Then
MsgBox aHyperlink.Name
End If
Next aHyperlink
See Chapter 17: Working with Item Bodies for more information.
There is no need to specify the path to the IE on the machine. For example, you can use the following code instead:
Shell (splitWord)
The default web browser will be opened. Moreover, the path to the IE can be wrong and depend on the machine (x86 or x64).
Finally, you may find the Getting Started with VBA in Outlook 2010 article helpful.
Can anyone help me figure out what's going wrong and how to fix it?
I'm trying to automate sending an email with some daily status information. I'd tried automating this from Access but kept running into (known but apparently unsolved) problems with GetObject(, "Outlook.Application") with Windows 8.1 64 and Outlook 2013. So I decided to automate starting from Outlook.
Anyway, I moved the mail message creation code into Outlook vba and had it start Access and run the Access code. This is all well and good until I get to creating the mail message. Everything starts just fine until it gets to writing to the body of message (using Word as the body editor). At the first "TypeText" command, I'm getting the error message in the title. If I click debug on the error notification dialog and then single-step through the line of code in question, it works just fine. I thought that there was some timing problem, so I stuck a 2-second wait in the code. No luck. The code in question, with some other oddities associated with testing (notably trying to type and then delete text), is below:
Public Sub CreateMetrics()
' Mail-sending variables
Dim mailApp As Outlook.Application
Dim accessApp As Access.Application
Dim mail As MailItem
Dim wEditor As Word.Document
Dim boolCreatedApp As Boolean
Dim i As Integer
Set mailApp = Application
' Create an Access application object and open the database
Set accessApp = CreateObject("Access.Application")
accessApp.OpenCurrentDatabase dbLoc
accessApp.Visible = True
' Open the desired form and run the click event hander for the start button
accessApp.DoCmd.OpenForm ("ProcessStatus")
accessApp.Forms![ProcessStatus].StartButton_Click
' Create the outgoing mail message
Set mail = Application.CreateItem(olMailItem)
mail.Display
mail.BodyFormat = olFormatHTML
Set wEditor = mailApp.ActiveInspector.WordEditor
With accessApp.Forms![ProcessStatus]
Debug.Print .lblToList.Caption
Debug.Print .lblSubject.Caption
Debug.Print .lblIntroduction.Caption
Debug.Print .lblAttachFilepath.Caption
End With
mail.To = accessApp.Forms![ProcessStatus].lblToList.Caption
mail.Recipients.ResolveAll
mail.Subject = accessApp.Forms![ProcessStatus].lblSubject.Caption
mail.Attachments.Add accessApp.Forms![ProcessStatus].lblAttachFilepath.Caption
Sleep 2000
' Error occurs in the next line ***********************************************
wEditor.Application.Selection.TypeText Text:="Test"
wEditor.Application.Selection.HomeKey
wEditor.Application.Selection.Delete Count:=4
wEditor.Application.Selection.PasteSpecial DataType:=wdPasteBitmap
wEditor.Application.Selection.HomeKey
wEditor.Application.Selection.TypeText accessApp.Forms![ProcessStatus].lblIntroduction.Caption
wEditor.Application.Selection.TypeText Text:=Chr(13) & Chr(13)
wEditor.Application.Selection.EndKey
' wEditor.Application.Selection.EndKey
' wEditor.Application.Selection.TypeText Text:=Chr(13)
' wEditor.Application.Selection.TypeText Text:=configs("EmailSignature")
' End With
With mailApp.Session.Accounts
i = 1
Do While i <= .Count
' Use either the specified email address OR the last outlook email address
If RegEx_IsStringMatching(.Item(i).SmtpAddress, accessApp.Forms![ProcessStatus].lblSenderRegex.Caption) Or i = .Count Then
mail.SendUsingAccount = .Item(i)
i = .Count + 1
Else
i = i + 1
End If
Loop
End With
mail.Save
accessApp.Quit
End Sub
I added a "mail.Display" just before the line that was causing the failure, which seemed, incorrectly, to have fixed the problem.
I have now solved this problem by executing a document.select on the document associated with the email I was creating. To select the right document (there doesn't seem to be any guarantee of which one that would be within the wEditor.Application.Documents collection, though it was typically the first one), I created an almost-certainly unique piece of text and assigned it to the body of the email, which I could then go and find. Here's the new code that I added to the code above:
Dim aDoc As Word.Document
Dim strUniqueID As String
. . .
mail.Attachments.Add accessApp.Forms![ProcessStatus].lblAttachFilepath.Caption
strUniqueID = accessApp.Forms![ProcessStatus].lblSubject.Caption & Rnd(Now()) & Now()
mail.Body = strUniqueID
' Search for the unique text. aDoc.Content has extra characters at the
' end, so compare only for the length of the unique text
For Each aDoc In wEditor.Application.Documents
If Left(aDoc.Content, Len(strUniqueID)) = strUniqueID Then
aDoc.Select
mail.Body = ""
End If
Next aDoc
wEditor.Application.Selection.TypeText Text:="Test"
. . .
I looked at a lot of examples of code that did this kind of thing. None of them performed a select or said anything about needing one. Debugging was made that much harder because the select occured implicitly when the debugger was invoked.
I'm pretty new to writing VBA scripts. Actually, I'm trying to write a small VBA script which will go through the newly received email, scan the body of the message and open all the urls(I'm targetting this script for a message which always contains a single URL) in a web browser like IE or FF or Chrome. I tried looking for similar Qs in SO and on Google. I found one here: How to launch a URL when an email arrives which is about how to open a URL when an email arrives. But it is always opening a fixed URL and not by going through the message body and picking the URL from there. Also, I found this: Using VB/VBA to search Outlook messages and extract specific data into Excel worksheet which go through the message body to pick/search something. In my scenario, I want to consolidate both but I'm not able to come up with a basic script. Could someone give me pointers in consolidating the two and help me achieve my target of opening URLs from message body whenever a new mail arrives in Outlook mailbox. Thanks in advance.
Sub LaunchURL(itm As MailItem)
Dim bodyString As String
Dim bodyStringSplitLine
Dim bodyStringSplitWord
Dim splitLine
Dim splitWord
bodyString = itm.Body
bodyStringSplitLine = Split(bodyString, vbCrLf)
For Each splitLine In bodyStringSplitLine
bodyStringSplitWord = Split(splitLine, " ")
For Each splitWord In bodyStringSplitWord
If Left(splitWord, 7) = "http://" Then
Shell ("C:\Program Files\Internet Explorer\IEXPLORE.EXE" & " " & splitWord)
End If
Next
Next
Set itm = Nothing
End Sub
Private Sub test()
Dim currItem As MailItem
Set currItem = ActiveInspector.currentItem
LaunchURL currItem
End Sub
Alpha, I thing that is little unsafe, even if your rule if only people from a particular domain for.
That is a good idea, when you check urlstring with variable you create (like link only from local intranet).
if splitWord like "my_company_internat_url" then '...
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