Solved

Outlook VB Script

Posted on 2009-07-16
21
614 Views
Last Modified: 2012-08-13
I have a new client that uses a VB script in outlook to automatically reply to clients who fill out a form on their website. The script takes the attached form which is a word doc, and gives it an invoice number which is next in sequence, then sends the word doc back with the invoice number filled in and prints it out. For some reason every time a new email comes in, i receive an 'Outlook has encountered a problem and needs to close' error. When i remove the OTM file, everything is fine and no errors show. I am not very familiar with VB and i cannot get a hold of the guys who wrote it. Could you please tell me where the error is int he code that is shutting down outlook.  Here is the code....
Private Sub Application_NewMail()
 
'** Added by T. Lewis - commented out by R. Longo
'VERSION 1.0 CLASS
'BEGIN
'  MultiUse = -1  'True
'End
'Attribute VB_Name = "ThisOutlookSession"
'Attribute VB_GlobalNameSpace = False
'Attribute VB_Creatable = False
'Attribute VB_PredeclaredId = True
'Attribute VB_Exposed = True
'Option Explicit
'**
 
    Dim fso As New FileSystemObject
    Dim fil As File
    Dim strReply As String
    Dim strBody As String
    Dim strTempFile As String
    Dim TS As TextStream
    Dim sOrderID As String
    Dim objFolder As MAPIFolder
 
    Set objFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
 
    ' A temporary variable that is completely worthless.
    Dim strTemp As String
    
    ' Note that in order to look at the most-recently received message, we need to sort the items
    ' by the time they were received, in decending order.  This step is CRITICAL; without it, you cannot rely
    ' upon the items being arranged in any particular order.  In my experiments, the way that the items were
    ' sorted within Outlook (for example, by "From" or by "Subject") affected which message appeared at the
    ' beginning of the collection, and which one appeared at the end.
 
    objFolder.Items.Sort "Received", True
 
    ' Somewhere down the line we will be creating an instance of the Word application.  Since we don't
    ' necessarily want to be creating and destroying it every time, we will set a global flag for this
    ' routine to indicate whether it has already been created or not.
 
    Dim IsWordCreated As Boolean
 
    ' The default value for this flag will be False.  Not every email will have an attachment that
    ' requires an instance of Word.
 
    IsWordCreated = False
 
    ' Create a MailItem object which we will use to enumerate through the collection
 
    Dim objNewMail As MailItem
    Dim objReplyMail As MailItem
 
    For Each objNewMail In objFolder.Items
 
    ' It is possible that a single NewMail event could be triggered by the arrival of multiple messages.
    ' We are only interested in unread messages, so we will use the UnRead property as the condition for
    ' continuing through our collection.  We will not be evaulating EVERY message;
 
      If objNewMail.UnRead Then 'Process if doc not read yet (opened)
 
        Dim strSender As String
        Dim sDateTime As String
        
        Dim colAttachments As Attachments ' a collection
        Set colAttachments = objNewMail.Attachments
 
        ' Create an enumeration variable to iterate through the Attachments collection
        Dim objAttachment As Attachment
        For Each objAttachment In colAttachments
 
            ' We are only concerned with Orange County Corporate Courier documents
            If Left(objAttachment.FileName, 4) = "OCCC" And Right(objAttachment.FileName, 3) = "doc" Then
              'Now we make sure we didn't already process this email
              sDateTime = CStr(objNewMail.ReceivedTime)
              iprocessed = CheckLog(sDateTime)
              If iprocessed = 0 Then
                ' We will be creating a temporary file, so we need a value for its filename
                Dim strFileName As String
                Dim strOrder    As String
                ' Create our temporary file in the C:\Temp directory, in the form of index,
                ' where index is the document's location within the Attachments collection.  Note that with this
                ' code, it is possible for files to be overwritten, which is acceptable.
 
                strTempFile = "C:\Temp\TempDoc_" & objAttachment.Index & ".doc"
                ' Save our attachment to the temp directory using our filename variable
                objAttachment.SaveAsFile strTempFile
                ' Create an instance of a Word application
                Dim appWord As Word.Application
                ' Check our global flag.  If an instance of Word has not been created, then we need
                ' to do so now.
                If Not IsWordCreated Then
 
                    ' Create an instance of the application
                    Set appWord = CreateObject("Word.Application")
                    ' Be sure our flag is now set
                    IsWordCreated = True
 
                End If ' Instance of Word check
 
                ' Now open our document in Word
                appWord.Documents.Open strTempFile
 
                'Get the next invoice number, increment number, and save for the next order
                Set TS = fso.OpenTextFile("c:\my documents\orders\sequence.txt", ForReading)
                sOrderID = TS.ReadLine
                lNum = CLng(sOrderID)
                lNum = lNum + 1
                sOrderID = CStr(lNum)
                TS.Close
                fso.DeleteFile ("c:\my documents\orders\sequence.txt")
                Set TS = fso.CreateTextFile("c:\my documents\orders\sequence.txt")
                TS.WriteLine sOrderID
                TS.Close
                
                ' Look for our bookmarks, which in this case we will presume it is there
                '** document security code
    
                Dim lngProtectType As Long
                lngProtectType = appWord.ActiveDocument.ProtectionType
                appWord.ActiveDocument.Unprotect
                Dim rngBookmark As Range
                appWord.ActiveDocument.Bookmarks("lngOrderID").Range.InsertAfter sOrderID
                'rngBookmark.Text = sOrderID
                Set rngBookmark = Nothing
                sSender = appWord.ActiveDocument.Bookmarks.Item("sSenderName").Range.Text
                'parse the text to remove the 'FORMTEXT' prefix
                If Len(sSender) > 11 Then
                    sSender = Mid$(sSender, 11)
                Else
                    sSender = ""
                End If
                appWord.ActiveDocument.Protect Type:=lngProtectType, NoReset:=True
 
                ' Save our document with its changes.
                strFileName = "C:\My Documents\orders\OCCC_" & sSender & "_" & sOrderID & ".doc"
                appWord.ActiveDocument.SaveAs FileName:=strFileName
                appWord.ActiveDocument.PrintOut
                
                '* Added by Russell *'
                '* Send a reply message.  This method will not fire off the
                '* dreaded Accounts Security Dialog Box (tested in Outlook 2000)
                strReply = "OCC Courier order number: " & sOrderID
                strBody = "Your request has been received, assigned invoice number " & sOrderID & ",  and scheduled for pickup and/or delivery."
                strBody = strBody & "  Please print two copies - attach one to package, and keep one copy for your files." & Chr(10) & Chr(13)
                strBody = strBody & "Please note: you should receive this reply message for each and every order document you send."
                strBody = strBody & "  If you do not receive a reply, please call 949-474-9000."
                Set objReplyMail = objNewMail.Reply
                objReplyMail.Subject = strReply
                objReplyMail.Body = strBody
                objReplyMail.Attachments.Add strFileName
                objReplyMail.Send
 
                appWord.ActiveDocument.Close
                    
                'Since we have dealt with this message by printing out the order form, we will mark the
                ' message as having been read.
                
                objNewMail.UnRead = False
                fso.DeleteFile (strTempFile)
              End If 'check to see that email is not in log
            End If ' objAttachment.FileName check
            
        Next ' Loop through the Attachments collection
            
        ' At this point, we're done with the loop, so we can start cleaning up our objects
        Set objAttachment = Nothing
        
        ' Destroy our collection object that its values do not accidentally persist between
        ' iterations of this same loop.
        
        Set colAttachments = Nothing
      End If 'End of body of code that processes emails with attachments
    Next ' For Each objNewMail.  The loop will have exited already if it encountered a read message.
    
    ' If we have created an instance of the Word application, then we need to destroy it at this time.
    If IsWordCreated Then
        appWord.Quit
        Set appWord = Nothing
    End If
    
    ' Go ahead and clean up our remaining objects
    Set objNewMail = Nothing
    Set objReplyMail = Nothing
    Set objFolder = Nothing
    
End Sub ' Application_NewMail
 
 
Function CheckLog(sDateTime As String) As Integer
 
    Dim fso As New FileSystemObject
    Dim fil As File
    Dim sFileDateTime
    Dim TS As TextStream
    
    iEmailProcessed = 0
    Set TS = fso.OpenTextFile("c:\My Documents\DateTimeLog.txt", ForReading)
    Do While Not TS.AtEndOfStream
        sFileDateTime = TS.ReadLine
        If sFileDateTime = sDateTime Then
            iEmailProcessed = 1
        End If
    Loop
    TS.Close
    
    Set TS = fso.OpenTextFile("c:\My Documents\DateTimeLog.txt", ForAppending)
    If iEmailProcessed = 0 Then
        TS.WriteLine sDateTime
    End If
    
    TS.Close
    Set fso = Nothing
    CheckLog = iEmailProcessed
    
End Function

Open in new window

0
Comment
Question by:jamax10
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 13
  • 8
21 Comments
 
LVL 76

Expert Comment

by:David Lee
ID: 24873267
Hi, jamax10.

It's impossible to tell where it's failing just by looking at the code.  At the very least we'd have to have some idea of where in the code it's failing.  My recommednation is set a breakpoint on line 25 and step through the code line by line until it fails.  It's also possible that the OTM file is damaged.  Have you tried saving the code to a text file, closing Outlook and deleting the OTM file, starting Outlook (which will create a new OTM file, then porting the code back in?
0
 

Author Comment

by:jamax10
ID: 24873409
no. i will try that in about an hour. If it still fails i will follow your suggestion on setting the break point. When i set a break point, do i remove the rest of the code? i will keep this open for the rest of the day just in case i have any more questions, then will award the points at the end of the day. thank you.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 24873521
No, don't remove any code.  The breakpoint will pause code execution at that line and let you manually step through it.  Unless the code does causes an immediate crash, then you'll be able to step through the code one line at a time and see where it's failing.  If we know where it fails, that is the instruction that's causing Outlook to crash, then we can offer some suggestions.
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:jamax10
ID: 24873778
Thank you. i will let you know what i find.
0
 

Author Comment

by:jamax10
ID: 24874399
I exported the code to text. closed outlook and reopened which recreated the OTM file. I reimported but outlook crashed again. while troubleshooting section by section, all of my Dim from line 16-23 and 89 says 'user-defined type not defined'. what does that mean?
0
 
LVL 76

Expert Comment

by:David Lee
ID: 24874511
"User-defined type not defined" means that the VB processor is missing references and doesn't know what type of object FileSystemObject, File, etc. is.  For most of the items that's fine.  I'm concerned about it not knowing what String is though.  That's an intrinsic data type.  Try this.

1.  Open the VB editor
2.  Click Tools > References
3.  Scroll through the list of available references and place a check next to the following items:

    Visual Basic for Applications
    Microsoft Outlook 12.0 Object Library
    OLE Automation
    Microsoft Office 12.0 Object Library
    Windows Script Host Object Model

If you don't have Outlook 2007, then the 12.0 above will be 11.0 or 10.0 or something like that.
   
0
 

Author Comment

by:jamax10
ID: 24874587
Am running it on Outlook 2000. checked all but window script host object model. cant find it in the list. still coming up with same error.
0
 

Author Comment

by:jamax10
ID: 24874592
does it make a difference that it says Private sub app at the top?
0
 
LVL 76

Expert Comment

by:David Lee
ID: 24874627
"still coming up with same error"
On every line from 16 - 23, or only some of them?

"does it make a difference that it says Private sub app at the top?"
No, that doesn't make any difference.  
0
 

Author Comment

by:jamax10
ID: 24874670
User-defined error come up on:
dim fso as new filesystemobject
dim fil as file
dim ts as textstream
dim appword as word.application
dim rngbookmark as range (line 125)
0
 

Author Comment

by:jamax10
ID: 24874699
i think i found the reference for the lines 16-23. in outlook 2000 instead of windows script host, it is microsoft scripting runtime..
0
 

Author Comment

by:jamax10
ID: 24874711
and the reference for appword is Word object library
0
 

Author Comment

by:jamax10
ID: 24874772
Thanks to your direction, some quick internet reading, and a little troubleshooting i have resolved all the User-Defined Errors (i think), but now when i run it, i receive a Run-Time Error '13' Type Mismatch on line 174? what is that?
0
 
LVL 76

Accepted Solution

by:
David Lee earned 500 total points
ID: 24874868
One of the items probably isn't an email.  Change line 51 from

    Dim objNewMail As MailItem

to

    Dim objNewMail As Object

Then throw in a test to see if the item is an email.  After line 54 insert

    If objNewMail.Class = olMail Then

Before line 174 insert

    End If


0
 

Author Comment

by:jamax10
ID: 24874879
Below the End If in line 173?
0
 
LVL 76

Expert Comment

by:David Lee
ID: 24874897
Yes.
0
 

Author Comment

by:jamax10
ID: 24874944
You are awesome!!!!! It doesn't error out any more, but when i sent a test email, it didn't run automatically. i had to open the VB Editor and click run. how do i make it run for each email automatically?
0
 
LVL 76

Expert Comment

by:David Lee
ID: 24874960
Is the code in the module ThisOutlookSession?
0
 

Author Comment

by:jamax10
ID: 24875008
no it is in module 1. i copied and pasted the code into ThisOutlookSession. The Test worked! you are Awesome!!
0
 

Author Closing Comment

by:jamax10
ID: 31604344
you are awesome! test worked! thank you for your patience!
0
 
LVL 76

Expert Comment

by:David Lee
ID: 24875013
Thanks!  Glad I could help.
0

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Excel copy picture into Outlook email 7 68
VBScript Issues 8 46
Hta File displays dynamic File names 4 46
Import CSV with All modify groups 15 33
Welcome, welcome!  If you are new to the series and haven't been following along, please take a brief moment to review the first three installments: Part 1 (http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/A_266-VBScri…
When it comes to writing scripts for a Client/Server computing environment it is essential to consider some way of enabling the authentication functionality within a script. This sort of consideration mainly comes into the picture when we are dealin…
The Email Laundry PDF encryption service allows companies to send confidential encrypted  emails to anybody. The PDF document can also contain attachments that are embedded in the encrypted PDF. The password is randomly generated by The Email Laundr…
Are you ready to implement Active Directory best practices without reading 300+ pages? You're in luck. In this webinar hosted by Skyport Systems, you gain insight into Microsoft's latest comprehensive guide, with tips on the best and easiest way…

749 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