Please help to generate an email

[kelsita_05]

Hi-
I've played around with VBA quite a bit, and can make it do things I want it to (usually). No formal training whatsoever, but I got picked to be in charge of this database, so I'm doing my best to learn.
Long story short- I'm using the following code to generate two email messages. I borrowed it from another database we use, and attempted to modify it accordingly. I have two command buttons, one for each email. The first button is "cmdEmailOffer" and the other is "Command53." Neither of them works to generate the email. However, it does pop up the correct error message based on the value of Field24 (see below). The other code from this form works, and I removed it from the part I copied below.
Essentially I'm in way over my head, but I have people who need this to work, and soon. No time to spend the next week poring over "Running Access 2000." Specific guidance is greatly appreciated. Feel free to make fun of me for not knowing what I'm doing!
FYI- I'm using what was originally an Access 2000 database in Access 2003 (it hasn't been converted). It's a front end/back end setup on a network. Some users still have Access 2000.
Thank you ever so much-




Option Compare Database
Option Explicit
Private varbody As Variant

Private Sub cmdEmailOffer_Click()
On Error GoTo HandleErr
Dim strTo As String
Dim strWhoName As String
Dim strNotFound As String
Dim i As Integer
Dim strCR As String
Dim intLastComma As Integer
Dim strErrMsg As String

strCR = Chr$(13)
strNotFound = vbNullString
varbody = vbNullString
intLastComma = 0

If Me.Field24.Value = True Then
strErrMsg = Me.[link name] & " is shown as having already accepted this assignment. Aborting email."
MsgBox strErrMsg, vbInformation, "Data Error"
Exit Sub
End If


' Get rid of leading semicolon
If Left(strNotFound, 2) = "; " Then
strNotFound = Right(strNotFound, Len(strNotFound) - 2)
End If

strWhoName = Me.Parent.SwitchName(Me.Field36) ' Link Name

Call CreateOfferBody1(strWhoName)

Call CreateEmail(Nz(Me.email))

GetOut:
Exit Sub

HandleErr:
Select Case Err.Number
Case Else
MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "Form_JobsInterpsJSubform.cmdEmailOffer_Click"
Resume GetOut
End Select

End Sub


Private Sub Command53_Click()
On Error GoTo HandleErr
Dim strTo As String
Dim strWhoName As String
Dim strNotFound As String
Dim i As Integer
Dim strCR As String
Dim intLastComma As Integer
Dim strErrMsg As String

strCR = Chr$(13)
strNotFound = vbNullString
varbody = vbNullString
intLastComma = 0

If Me.Field24.Value = False Then
strErrMsg = Me.[link name] & " is shown as not having accepted this assignment. Aborting email."
MsgBox strErrMsg, vbInformation, "Data Error"
Exit Sub
End If


' Get rid of leading semicolon
If Left(strNotFound, 2) = "; " Then
strNotFound = Right(strNotFound, Len(strNotFound) - 2)
End If
' If some BCC names lack email address, pop up message box.
If strNotFound <> vbNullString Then
MsgBox "Email address missing for the following contractor(s) for the BCC box: " & strNotFound & ". Email will not be addressed to said contractor(s).", vbInformation, "Information: Missing Emails"
End If

strWhoName = Me.Parent.SwitchName(Me.Field36) ' Link Name

Call CreateOfferBody2(strWhoName)

Call CreateEmail2(Nz(Me.email))

GetOut:
Exit Sub

HandleErr:
Select Case Err.Number
Case Else
MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "Form_JobsInterpsJSubform.Command53_Click"
Resume GetOut
End Select
End Sub




Private Sub CreateOfferBody1(strWhoName As String)
On Error GoTo HandleErr

Const cIndent As String = " "
Const cBodyUBnd As Integer = 28
Dim astrBody(1 To 28) As String
Dim i As Integer
Dim indxBody As Integer
Dim strCR As String
Dim lngPos As Long

strCR = Chr$(13)

astrBody(1) = "Dear " & strWhoName & ":"
astrBody(2) = ""
astrBody(3) = "Would you be available to work on the following translating assignment?"
astrBody(4) = ""
astrBody(5) = "Project Title:"
astrBody(6) = cIndent & Me.Parent.Project
astrBody(7) = cIndent & Me.Parent.office
astrBody(8) = ""
astrBody(9) = "Project Dates:"
astrBody(10) = cIndent & Me.Parent.[Start date] & " - " & Me.Parent.[End date]
astrBody(11) = ""
astrBody(12) = "Program Agency:"
astrBody(13) = cIndent & Me.Parent.agency
astrBody(14) = ""
astrBody(15) = "Country:"
astrBody(16) = cIndent & Me.Parent.Country
astrBody(17) = ""
astrBody(18) = "Language:"
astrBody(19) = cIndent & Me.Parent.language
astrBody(20) = ""
astrBody(21) = "Please confirm your acceptance of this assignment by responding to this e-mail and/or by phone before COB ."
astrBody(22) = ""

For i = 1 To cBodyUBnd
varbody = varbody & astrBody(i) & strCR
Next i

GetOut:
Exit Sub

HandleErr:
Select Case Err.Number
Case Else
MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "Form_JobsInterpsJSubform.CreateOfferBody"
Resume GetOut
End Select

End Sub

Private Sub CreateEmail(strTo As String)
On Error GoTo HandleErr

Const cMailItem = "0"
Dim objOutlook As Object
Dim objNewMail As Object
Dim varRecip As Variant
Dim varAttach As Variant

Set objOutlook = CreateObject("Outlook.application")

If objOutlook Is Nothing Then
MsgBox "Unable to initialize Outlook Application "
Exit Sub
End If

Set objNewMail = objOutlook.Createitem(cMailItem)
With objNewMail
.To = strTo
' .subject = Me.Parent.Project & "; " & Me.Parent.[Start date] & " - " & Me.Parent.[End date]
.subject = " assignment?"
.Body = varbody
.Display
MakeActive (.subject)
End With

Set objNewMail = Nothing
Set objOutlook = Nothing


GetOut:
Exit Sub

HandleErr:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "Form_JobsInterpsJSubform.CreateEmail"
Resume GetOut

End Sub


Private Sub CreateOfferBody2(strWhoName As String)
On Error GoTo HandleErr

Const cIndent As String = " "
Const cBodyUBnd As Integer = 28
Dim astrBody(1 To 28) As String
Dim i As Integer
Dim indxBody As Integer
Dim strCR As String
Dim lngPos As Long

strCR = Chr$(13)

astrBody(1) = "Dear " & strWhoName & ":"
astrBody(2) = ""
astrBody(3) = "Thank you for taking this project."
astrBody(4) = ""
astrBody(5) = "Project Title:"
astrBody(6) = cIndent & Me.Parent.Project
astrBody(7) = cIndent & Me.Parent.office
astrBody(8) = ""
astrBody(9) = "Project Dates:"
astrBody(10) = cIndent & Me.Parent.[In Date] & " - " & Me.Parent.[Due Date]
astrBody(17) = ""
astrBody(18) = "Language:"
astrBody(19) = cIndent & Me.Parent.language
astrBody(20) = ""
astrBody(21) = "The document(s) to be translated and your translation instructions are attached."
astrBody(22) = "Please return the translation by (time) on (date)."
astrBody(23) = ""
astrBody(24) = "Feel free to call with any questions."
astrBody(25) = "Please confirm receipt."
astrBody(26) = ""

For i = 1 To cBodyUBnd
varbody = varbody & astrBody(i) & strCR
Next i

GetOut:
Exit Sub

HandleErr:
Select Case Err.Number
Case Else
MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "Form_JobsInterpsJSubform.CreateOfferBody"
Resume GetOut
End Select
End Sub


Private Sub CreateEmail2(strTo As String)
On Error GoTo HandleErr

Const cMailItem = "0"
Dim objOutlook As Object
Dim objNewMail As Object
Dim varRecip As Variant
Dim varAttach As Variant

Set objOutlook = CreateObject("Outlook.application")

If objOutlook Is Nothing Then
MsgBox "Unable to initialize Outlook Application "
Exit Sub
End If

Set objNewMail = objOutlook.Createitem(cMailItem)
With objNewMail
.To = strTo
' .subject = Me.Parent.Project & "; " & Me.Parent.[Start date] & " - " & Me.Parent.[End date]
.subject = " job"
.Body = varbody
.Display
MakeActive (.subject)
End With

Set objNewMail = Nothing
Set objOutlook = Nothing


GetOut:
Exit Sub

HandleErr:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "Form_JobsInterpsJSubform.CreateEmail2"
Resume GetOut

End Sub

 

[kelsita_05]

Another important thing I forgot to mention- the error it gives me is:
Error 2465: Application-defined or object-defined error.
Please?