Solved

Outlook VBA problems

Posted on 2009-07-07
17
624 Views
Last Modified: 2013-11-10
Hi all,

I thought we had this one taken care of and looks like it isnt... I have done about all the homework I can think of on this problem and explain below in vivid detail whats going on.

Created a rule looking for the word "sendme" in the subject line. if found processs the following:

   Mark as Read (this works)
   Execute VBA Script which has a Shell ("") call in it (does NOT work).

As stated above, the email is marked as READ, but the next step of the rule seems to in part fail. After the message is marked read I execute the following VBA:

Sub olRule_sendme(olkMessage As Outlook.MailItem)

Dim params() As String
Dim addy As String
    params = Split(Replace(olkMessage.Subject, "  ", " "), " ")
    addy = GetSMTPAddress(olkMessage.SenderEmailAddress)
    Shell ("D:\newmonthly\reports\endofcruise.bat " & params(1) & " " & params(2) & " " & params(3) & " " & addy)
    olkMessage.Subject = "DELETE FOR GOOD"
    olkMessage.Save
    olkMessage.Delete
    Set olkMessage = Nothing
    Set olkMessage = Session.GetDefaultFolder(olFolderDeletedItems).Items.Find("[Subject] = 'DELETE FOR GOOD'")
    If TypeName(olkMessage) <> "Nothing" Then
        olkMessage.Delete
    End If

End Sub

This VBA should do the following:

1. Take the words of the subject and pass them along to the shell call
2. flag the message to be deleted
3. delete perm. the email

What appears to be happening is, the VBA IS called, I changed the code to try and see where it fails by adding msgbox lines:

Sub olRule_sendme(olkMessage As Outlook.MailItem)

Dim params() As String
Dim addy As String
    params = Split(Replace(olkMessage.Subject, "  ", " "), " ")
    addy = GetSMTPAddress(olkMessage.SenderEmailAddress)
    MsgBox ("Params " & params(1) & " " & params(2) & " " & params(3) & " " & addy)
    Shell ("D:\newmonthly\reports\endofcruise.bat " & params(1) & " " & params(2) & " " & params(3) & " " & addy)
    MsgBox ("Params " & params(1) & " " & params(2) & " " & params(3) & " " & addy)
    olkMessage.Subject = "DELETE FOR GOOD"
    olkMessage.Save
    olkMessage.Delete
    Set olkMessage = Nothing
    Set olkMessage = Session.GetDefaultFolder(olFolderDeletedItems).Items.Find("[Subject] = 'DELETE FOR GOOD'")
    If TypeName(olkMessage) <> "Nothing" Then
        olkMessage.Delete
    End If

End Sub

What does happen is, the 1st message box comes up and displays my params() promerly the first time. Then it dies. no error message, no shell call at all and no second message box to display the params() again. so its halting on the SHELL line.

Now on the batch file side, I have made the batch file to do nothing but echo the date time and the parameters passed to a text file. If I call the batch file manually via the command line in dos, I get entries into my text file. I have re-verified the path to this file as being correct. I also changed the SHELL line to call just notepad.exe and it WORKS. But it refuses to call my batch file. I am also using outlook as a local admin account.

So now I pass this on to ??? :)

Thanks!!
0
Comment
Question by:smyers051972
  • 9
  • 8
17 Comments
 
LVL 1

Author Comment

by:smyers051972
Comment Utility
Before I forget, I know of the outlook security issue, I installed Outlook advanced security by Mapilabs inc and was prompted for an action to allow or disallow the script to run, I selected allow and checked ALWAYS ALLOW.

Thanks :)
0
 
LVL 59

Expert Comment

by:Chris Bottomley
Comment Utility
Haven't set up a test but try:

Shell ("D:\newmonthly\reports\endofcruise.bat " & params(1) & " " & params(2) & " " & params(3) & " " & addy & "")

Chris
0
 
LVL 1

Author Comment

by:smyers051972
Comment Utility
Didnt work :(
Same thing, 1st msg box popped, then died. second didnt pop and no entries in the text file were made.

The msgboxs will be removed of course after testing.
0
 
LVL 59

Expert Comment

by:Chris Bottomley
Comment Utility
I may be missing something in your setup or my understanding but:

Chris
Dim shell As Object
 

Set shell = CreateObject("wscript.shell")

shell.Run ("D:\newmonthly\reports\endofcruise.bat " & params(1) & " " & params(2) & " " & params(3) & " " & addy & "")

)

Open in new window

0
 
LVL 1

Author Comment

by:smyers051972
Comment Utility
Well, sort of, the params are parsed from the subject line... I can try and incorperate your code above into the script?
0
 
LVL 1

Author Comment

by:smyers051972
Comment Utility
Here is a more simpler version of the script, it just parses the subject line and passes the parameters.

Sub olRule_sendme(olkMessage As Outlook.MailItem)

Dim params() As String

Dim addy As String

    params = Split(Replace(olkMessage.Subject, "  ", " "), " ")

    addy = GetSMTPAddress(olkMessage.SenderEmailAddress)

    shell ("D:\NewMonthly\reports\endofcruise.bat " & params(1) & " " & params(2) & " " & params(3) & " " & addy)

    

End Sub

Open in new window

0
 
LVL 59

Expert Comment

by:Chris Bottomley
Comment Utility
APologies I assumed you would be happy merging it so try this:

Chris
Sub olRule_sendme(olkMessage As Outlook.MailItem)
 

Dim params() As String

Dim addy As String

Dim shell As Object

    params = Split(Replace(olkMessage.Subject, "  ", " "), " ")

    addy = GetSMTPAddress(olkMessage.SenderEmailAddress)

Set shell = CreateObject("wscript.shell")

shell.Run ("D:\newmonthly\reports\endofcruise.bat " & params(1) & " " & params(2) & " " & params(3) & " " & addy & "")

    olkMessage.Subject = "DELETE FOR GOOD"

    olkMessage.Save

    olkMessage.Delete

    Set olkMessage = Nothing

    Set olkMessage = Session.GetDefaultFolder(olFolderDeletedItems).Items.Find("[Subject] = 'DELETE FOR GOOD'")

    If TypeName(olkMessage) <> "Nothing" Then

        olkMessage.Delete

    End If
 

End Sub

Open in new window

0
 
LVL 1

Author Comment

by:smyers051972
Comment Utility
Didnt work, its running but dies at the shell command.  I modified the code to open a MsgBox to test it instead of the shell call, the message box popped up and showed my parameters, even changed the batch file name to eoc.bat just incase for whatever reason it didnt like the length of the path and filename which shouldnt be an issue, when the message box completed it then finished the script, deleting the email.  With the shell call it just dies, doesnt call the batch file and doesnt delete the message.

Here is the code & screen shot showing what I am talking about, I censored the email address to protect the innocent =)
Sub olRule_sendme(olkMessage As Outlook.MailItem)

 

Dim params() As String

Dim addy As String

Dim shell As Object

    params = Split(Replace(olkMessage.Subject, "  ", " "), " ")

    addy = GetSMTPAddress(olkMessage.SenderEmailAddress)

Set shell = CreateObject("wscript.shell")

'shell.Run ("D:\newmonthly\reports\eoc.bat " & params(1) & " " & params(2) & " " & params(3) & " " & addy & "")

MsgBox ("D:\newmonthly\reports\eoc.bat " & params(1) & " " & params(2) & " " & params(3) & " " & addy & "")

    olkMessage.Subject = "DELETE FOR GOOD"

    olkMessage.Save

    olkMessage.Delete

    Set olkMessage = Nothing

    Set olkMessage = Session.GetDefaultFolder(olFolderDeletedItems).Items.Find("[Subject] = 'DELETE FOR GOOD'")

    If TypeName(olkMessage) <> "Nothing" Then

        olkMessage.Delete

    End If

 

End Sub

Open in new window

eoc.bmp
0
What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 
LVL 59

Expert Comment

by:Chris Bottomley
Comment Utility
I appreciate the batch file is simple but can you supply it so I can test with htat one since my tests on the other computer were fine.

Chris
0
 
LVL 1

Author Comment

by:smyers051972
Comment Utility
Yes it really was this simple... Just a test batch file that works from command line but not the script execution side...

This issue really does die at the SHELL command within the VBA... When I examine the _eoc.txt file there is no enties on it showing it never executed except manually from command line.

Thanks!


@ECHO OFF

ECHO TEST...

ECHO %DATE% %TIME% %0 %1 %2 %3 %4 >> D:\newmonthly\reports\_eoc.txt

Open in new window

0
 
LVL 59

Expert Comment

by:Chris Bottomley
Comment Utility
Just run it as below, (different path) and the output file is created an populated as per the msgbox.

I don't think I changed anything other than the path data.

Chris


Sub olRule_sendme(olkMessage As Outlook.mailitem)

 

Dim params() As String

Dim addy As String

Dim shell As Object

    params = Split(Replace(olkMessage.subject, "  ", " "), " ")

    addy = Sharath.GetSMTPAddress(olkMessage.SenderEmailAddress)

Set shell = CreateObject("wscript.shell")

shell.Run ("D:\newmonthly\reports\eoc.bat " & params(1) & " " & params(2) & " " & params(3) & " " & addy & "")

'MsgBox ("D:\newmonthly\reports\eoc.bat " & params(1) & " " & params(2) & " " & params(3) & " " & addy & "")

    olkMessage.subject = "DELETE FOR GOOD"

    olkMessage.Save

    olkMessage.Delete

    Set olkMessage = Nothing

    Set olkMessage = Session.GetDefaultFolder(olFolderDeletedItems).items.Find("[Subject] = 'DELETE FOR GOOD'")

    If TypeName(olkMessage) <> "Nothing" Then

        olkMessage.Delete

    End If

 

End Sub

Open in new window

0
 
LVL 1

Author Comment

by:smyers051972
Comment Utility
Hi there,

I tried it as requested and still it failed.  It marked the message as read and stopped at the shell execution.  It failed to delete the message, telling me it stopped at the shell execution.

Thanks!
0
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 500 total points
Comment Utility
Fresh eyes!

I'm not aware that you necessarily have the extra sub and besides even if you have the rule code was explicit in regard to it's location so try replacing the sub olRule_sendme as below and append the sub GetSMTPAddress if you don't already have it.

Chris
Sub olRule_sendme(olkMessage As Outlook.mailitem)

 

Dim params() As String

Dim addy As String

Dim shell As Object

    params = Split(Replace(olkMessage.subject, "  ", " "), " ")

    addy = GetSMTPAddress(olkMessage.SenderEmailAddress)

Set shell = CreateObject("wscript.shell")

shell.Run ("D:\newmonthly\reports\eoc.bat " & params(1) & " " & params(2) & " " & params(3) & " " & addy & "")

'MsgBox ("D:\newmonthly\reports\eoc.bat " & params(1) & " " & params(2) & " " & params(3) & " " & addy & "")

    olkMessage.subject = "DELETE FOR GOOD"

    olkMessage.Save

    olkMessage.Delete

    Set olkMessage = Nothing

    Set olkMessage = Session.GetDefaultFolder(olFolderDeletedItems).items.Find("[Subject] = 'DELETE FOR GOOD'")

    If TypeName(olkMessage) <> "Nothing" Then

        olkMessage.Delete

    End If

 

End Sub
 

Function GetSMTPAddress(ByVal strAddress As String)

' As supplied by Vikas Verma ... see

' http://blogs.msdn.com/vikas/archive/2007/10/24/oom-getting-primary-smtp-address-from-x400-x500-sip-ccmail-etc.aspx

Dim olApp As Object

Dim oCon As Object

Dim strKey As String

Dim oRec As Object

Dim strRet As String

Dim fldr As Object

    'IF OUTLOOK VERSION IS >= 2007 THEN USES NATIVE OOM PROPERTIES AND METHODS

    On Error Resume Next

    Set olApp = Application

    Set fldr = olApp.GetNamespace("MAPI").GetDefaultFolder(10).folders.Item("Random")

    If fldr Is Nothing Then

        olApp.GetNamespace("MAPI").GetDefaultFolder(10).folders.Add "Random"

        Set fldr = olApp.GetNamespace("MAPI").GetDefaultFolder(10).folders.Item("Random")

    End If

    On Error GoTo 0

    If CInt(Left(olApp.Version, 2)) >= 12 Then

        Set oRec = olApp.Session.CreateRecipient(strAddress)

        If oRec.Resolve Then

            strRet = oRec.AddressEntry.GetExchangeUser.PrimarySmtpAddress

        End If

    End If

    If Not strRet = "" Then GoTo ReturnValue

    'IF OUTLOOK VERSION IS < 2007 THEN USES LITTLE HACK

    'How it works

    '============

    '1) It will create a new contact item

    '2) Set it's email address to the value passed by you, it could be X500,X400 or any type of email address stored in the AD

    '3) We will assign a random key to this contact item and save it in its Fullname to search it later

    '4) Next we will save it to local contacts folder

    '5) Outlook will try to resolve the email address & make AD call if required else take the Primary SMTP address from its cache and append it to Display name

    '6) The display name will be something like this " ( email.address@server.com )"

    '7) Now we need to parse the Display name and delete the contact from contacts folder

    '8) Once the contact is deleted it will go to Deleted Items folder, after searching the contact using the unique random key generated in step 3

    '9) We then need to delete it from Deleted Items folder as well, to clean all the traces

    Set oCon = fldr.items.Add(2)

    oCon.Email1Address = strAddress

    strKey = "_" & Replace(Rnd * 100000 & Format(Now, "DDMMYYYYHmmss"), ".", "")

    oCon.FullName = strKey

    oCon.Save

    strRet = Trim(Replace(Replace(Replace(oCon.Email1DisplayName, "(", ""), ")", ""), strKey, ""))

    oCon.Delete

    Set oCon = Nothing

    Set oCon = olApp.Session.GetDefaultFolder(3).items.Find("[Subject]=" & strKey)

    If Not oCon Is Nothing Then oCon.Delete

ReturnValue:

    GetSMTPAddress = strRet

End Function

Open in new window

0
 
LVL 1

Author Comment

by:smyers051972
Comment Utility
OK, before I accept that last post by you (as it WORKED), I already did have the GET SMTP thing copied in, but when I removed all code and pasted ONLY that from above, it WORKED.

What is the problem is it location specific?

THANK YOU!
0
 
LVL 59

Expert Comment

by:Chris Bottomley
Comment Utility
Can't say as such since I can't see the old script BUT for example if your old copy used early binding it might have failed but it ought to have done so whatever you used i.e. the msgbox output as well as shell output.

Distasteful as it sounds all I can suggest is that the different sub declaration perhaps returned something slightly dodgy that msgbox could handle but that shell could not ... or the wind has changed direction!

Chris
0
 
LVL 1

Author Closing Comment

by:smyers051972
Comment Utility
Thank you so much for your help!
0
 
LVL 59

Expert Comment

by:Chris Bottomley
Comment Utility
Glad it helped, though as I said it's a bit distasteful that we couldn't narrow in on the precise problem

Chris
0

Featured Post

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

Follow this checklist to learn more about the 15 things you should never include in an email signature from personal quotes, animated gifs and out-of-date marketing content.
If you don't know how to downgrade, my instructions below should be helpful.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

771 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now