Outlook VB Script

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

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?

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.

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.

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?

"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:

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

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?

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?

Featured Post

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Script to copy or move mouse-selected collection of files plus targets referenced by shortcuts (.lnk)
The purpose of this article is to help illuminate the real challenges and options available (where they may exist) for utilizing simple scriptin…

This script will sweep a range of IP addresses (class c only, 255.255.255.0) and report to a log the version of office installed.
What it does:
1.) Creates log file in the directory the script is run from (if it doesn't already exist)
2.) Sweep…

Internet Business Fax to Email Made Easy -
With eFax Corporate (http://www.enterprise.efax.com), you'll receive a dedicated online fax number, which is used the same way as a typical analog fax number.
You'll receive secure faxes in your email, fr…

This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory.
NOTE: For Outlook 2016 and 2013 perform the exact same steps.
Open a new email: Click the New email button in Outlook.
Start typing the address: …