Replace method in .oft template

[A1CLowe]

Good morning forums,
I have yet another question that has been giving me issues lately. I am probably just going about all wrong. I am working on a replace function to replace %reasonforvisit% with the actual field value and so far the code runs without error however; the data is not passed and now the main menu wont open after the form closes. Is there also a way to get this code to automatically send rather than display the email? Ive tried setting .display to .send but i never get the email. My replace function looks like this and bear with me you'll probably find a million mistakes..,

Private Sub Command38_Click()
Dim intUSL As Integer
Dim olApp As Object
Dim objMail As Object
Dim strRFV As String

strRFV = Me.Reason_or_Visit

'Set the record as completed and remove it from the Customer Queue.
       Me.Status = "Completed"
       Me.Date_Time_of_Completion = Now()
           RunCommand acCmdSaveRecord
               Forms![Customer_Queue]![Servicing].Form.RecordSource = "Servicing"

'Keep going if there is an error
On Error Resume Next

'See if Outlook is open
Set olApp = GetObject(, "Outlook.Application")

'Outlook is not open
If Err Then

'Create a new instance of Outlook
Set olApp = CreateObject("Outlook.Application")
End If

'Create e-mail item
Set objMail = olApp.CreateItemFromTemplate(Application.CurrentProject.Path + "\untitled.oft")
With objMail
objMail.bodyformat = olFormatHTML
objMail.HTMLBody = Replace(objMail.HTMLBody, "%reasonforvisit%", strRFV)
objMail.sentonbehalfofname = ""
.To = Me.Cust_Email
.Subject = ""
.Attachments.Add ""
objMail.send
End With
DoCmd.Close

'Tells the database Who is logged in and which permission level they have.
   intUSL = DLookup("[Password Type]", "Tech Login Info", "[Technician]='" & Forms!frmUSL.txtUN & "'")
   Forms!frmUSL.txtUSL = intUSL
       'Opens the correct form based on what permissions the user has.
           Select Case intUSL
               Case 2
                   DoCmd.OpenForm "Main Menu", acNormal, , , acFormReadOnly
               Case 1
                   DoCmd.OpenForm "Sup_Admin Form", acNormal
               Case 3
                   MsgBox "Not configured yet", vbExclamation, "Not configured"
               Case 4
                   MsgBox "Not configured yet", vbExclamation, "Not configured"
       End Select


'Clean up
Set olApp = Nothing
Set objMail = Nothing
End Sub

 

[DavidAtWork]

Have you tried stepping through this code and inspecting the values of the variables to see if it's behaving as you'd expect.
The Docmd.Close line, what exactly are you trying to close here?
The acutal code for the email looks ok, but if you want to hide the email, try:
olApp.Visible = False

David

 

[A1CLowe]

Alright so I've got everything but the replace function working. I've tried all sorts of different methods to get the placeholder text to change to what it's supposed to be. Also the email still won't automatically send. I still have to have .display so I can send it manually. Here is my code now.

Private Sub Command38_Click()
Dim intUSL As Integer
Dim olApp As Object
Dim objMail As Object
Dim strRFV As String

Me.Reason_or_Visit.SetFocus
strRFV = Me.Reason_or_Visit.Text

'Set the record as completed and remove it from the Customer Queue.
       Me.Status = "Completed"
       Me.Date_Time_of_Completion = Now()
           RunCommand acCmdSaveRecord
               Forms![Customer_Queue]![Servicing].Form.RecordSource = "Servicing"

'Keep going if there is an error
On Error Resume Next

'See if Outlook is open
Set olApp = GetObject(, "Outlook.Application")

'Outlook is not open
If Err Then
'Create a new instance of Outlook
Set olApp = CreateObject("Outlook.Application")
End If

'Create e-mail item
Set objMail = olApp.CreateItemFromTemplate(Application.CurrentProject.Path + "\untitled.html")
objMail.HTMLbody = Replace(objMail.HTMLbody, "%reasonforvisit%", strRFV)
With objMail
objMail.sentonbehalfofname = "(E-Mail Removed)"
.To = Me.Cust_Email
.Subject = "2 CPTS Customer Survey"
.Attachments.Add "(Path Removed)"
DoCmd.Close
.Display

'Tells the database Who is logged in and which permission level they have.
   intUSL = DLookup("[Password Type]", "Tech Login Info", "[Technician]='" & Forms!frmUSL.txtUN & "'")
   Forms!frmUSL.txtUSL = intUSL
       'Opens the correct form based on what permissions the user has.
           Select Case intUSL
               Case 2
                   DoCmd.OpenForm "Main Menu", acNormal, , , acFormReadOnly
               Case 1
                   DoCmd.OpenForm "Sup_Admin Form", acNormal
               Case 3
                   MsgBox "Not configured yet", vbExclamation, "Not configured"
               Case 4
                   MsgBox "Not configured yet", vbExclamation, "Not configured"
       End Select
End With

'Clean up
Set olApp = Nothing
Set objMail = Nothing
End Sub

 

[thechazm]

Is the name of the string really "%reasonforvisit%" or is it reasonforvisit? The reason I ask is are you using the % signs as wild cards or is that the actual text? If you trying to use wild cards then don't but if they are not then disregard my comment.

 

[A1CLowe]

The string was actually %reasonforvisit% in the email as a placeholder, I took the % off as I guess I don't really need it. However; I still am having no sucess with it actually changing the placeholder to what I need.

 

[thechazm]

Can you post the template that you are trying to use for your emails?

 

[A1CLowe]

I'm on my phone so I can only copy what it says.

Greetings,

Recently you visited finance for assistance with reasonforvisit related issues. Please take this time to grade our performance by completing the attached survey.

We look forward to hearing from you!

Thanks,
CPTS Staff

 

[thechazm]

I would recommend putting a debug.print right before your line that does the replace and check your objects html. Something like below and post the findings here.

debug.pring objMail.HTMLbody
 
objMail.HTMLbody = Replace(objMail.HTMLbody, "%reasonforvisit%", strRFV)

 

[A1CLowe]

No value came out of it.. Just a blank immediate window.. Even after adding my breakpoint.

 

[thechazm]

Gotcha try using your replace function on the .body of the object like this instead of the one you have.

Instead of:
 
objMail.HTMLbody = Replace(objMail.HTMLbody, "%reasonforvisit%", strRFV)
 
Try:
 
objMail.Body = Replace(objMail.Body, "%reasonforvisit%", strRFV)

 

[A1CLowe]

Still no results with changing it to .body instead of .htmlbody

 

[thechazm]

I really think it's something to do with the template file your trying to use but I might be wrong. The reason why is when you did a debug.print and it returned nothing then that tells me there is nothing that the replace function can find and replace.

I'm not sure I have a good answer for this one without actually able to get my hands dirty.

Here is an old function I wrote to send out emails for notification of scheduled schools but it may or may not help in this situation because I didn't use a template.

Function SendEmailChangedSchools()
Dim mailItem As Outlook.mailItem, rsc As DAO.Recordset
Dim lngPersonnelNumber As Long
Dim strBody As String
Dim strEmail As Variant
Dim strNoEmail(999999) As String, i As Long, strText As String
Dim strHeader As String
Set db = CurrentDb
Set rsc = db.OpenRecordset("SELECT tblPersonal.Rate, tblPersonal.[Last Name], tblPersonal.[First Name], tblPersonal.Shop, " & _
        "tblPersonal.[Badge Number], tblPersonal.[Supervisor Code], tblPersonal.Code, tblPersonal.Email_Address, " & _
        "tblChangedSchool.[Course Number], tblChangedSchool.[Old Scheduled Date], tblChangedSchool.[Old Note], " & _
        "tblChangedSchool.[New Scheduled Date], tblChangedSchool.[New Note], tblChangedSchool.Location, tblPersonal.AutoNumber " & _
        "FROM tblPersonal INNER JOIN tblChangedSchool ON tblPersonal.[AutoNumber] = tblChangedSchool.[Personnel Number];")
' Open Outlook
InitOutlook
    strBody = "This system generated email is to inform you that a school you were scheduled for has been changed. Please update " & _
    "your calendar of the change. If you have any questions please contact your School Coordinator/Training Manager." & vbCrLf & vbCrLf
    
    StatusLabel "Building Emails for Changed Schools"
    
    If rsc.EOF = True Then
        MsgBox "No Changes were found.", vbOKOnly, "No Changes Found"
        
        rsc.Close
        Exit Function
    End If
    rsc.MoveFirst
    Do While Not rsc.EOF
    strEmail = rsc("Email_Address")
    If IsNull(strEmail) Then
        strNoEmail(i) = rsc("Rate") & " " & rsc("Last Name")
        i = i + 1
    Else
        ' Grab Information for Email
        lngPersonnelNumber = rsc("AutoNumber")
        strText = "Rate: " & rsc("Rate") & vbCrLf
        strText = strText & "Name: " & rsc("Last Name") & ", " & rsc("First Name") & vbCrLf
        strText = strText & "Course: " & rsc("Course Number") & vbCrLf & vbCrLf
        strText = strText & "Old scheduled date and time: " & rsc("Old Scheduled Date") & " " & rsc("Old Note") & vbCrLf & vbCrLf
        strText = strText & "New scheduled date and time: " & rsc("New Scheduled Date") & " " & rsc("New Note")
        Set mailItem = outlookApp.CreateItem(olMailItem)
        mailItem.To = strEmail & ""
        mailItem.Subject = "Notification of Changed School"
        mailItem.Body = strBody & strText
        mailItem.Save
        mailItem.Close olSave
    End If
Skip:
    rsc.MoveNext
    strText = ""
Loop
Do While i <> 0
    i = i - 1
    MsgBox "Could not find email for: " & strNoEmail(i) & " Please contact them of the change and have the email updated in the system."
Loop
StatusLabel "Individual Emails Completed"
rsc.Close
Set mailItem = Nothing
StatusLabel "Completed!"
Cleanup
End Function

If I can think of anything else I'll let you know. Hopefully someone else will chime in and help out.

 

[A1CLowe]

Unfortunately that's not really what I need, I just need a way to send an email based of a template. Whether it be .oft (Preferred) .html, .txt, .doc or what have you. It just needs to be a template so someone with very little or actually someone with no VBA experience can go in and change the template to their liking whenever a new change in leadership decides they don't like the email the way it is. As long as the code has a way to find that file, change that one little bit of text and change it to the new text, then send. If there is a simpler template to use then I'm all for it. It just seems .oft templates are stubborn to work with.

 

[DavidAtWork]

If you can't get the replace method to work, you could try another approach by wording the template differently and incorporate the reason for visit in the email subject
.Subject = "Your recent visit for " & strRFV

Greetings,

Thank you for your recent visit to finance for assistance. Please take this time to grade our performance by completing the attached survey.

We look forward to hearing from you!

Thanks,
CPTS Staff

The issue related to the email not sending, I've just looked at your original code and that should error because you have:
With objMail
objMail.bodyformat = olFormatHTML
objMail.HTMLBody = Replace(objMail.HTMLBody, "%reasonforvisit%", strRFV)
objMail.sentonbehalfofname = ""
.To = Me.Cust_Email
.Subject = ""
.Attachments.Add ""
objMail.send
End With

Should be (I'd suggest removing any lines not used or set to "")
With objMail
.bodyformat = olFormatHTML
.HTMLBody = Replace(objMail.HTMLBody, "%reasonforvisit%", strRFV)
.sentonbehalfofname = ""
.To = Me.Cust_Email
.Subject = ""
.Attachments.Add ""
.send
End With

If this still fails to send, do you get any security warnings? If so you might want to use the object safe mail method as it's always worked fine for me

David

 

[thechazm]

Look at the contents of an OFT file below:

Content-Type: multipart/signed;
 protocol="application/x-pkcs7-signature";
 micalg=SHA1;
 boundary="----=_NextPart_000_001A_01CE13D9.ED9885F0"
This is a multi-part message in MIME format.
------=_NextPart_000_001A_01CE13D9.ED9885F0
Content-Type: text/plain;
 charset="us-ascii"
Content-Transfer-Encoding: 7bit
Greetings,
Recently you visited finance for assistance with reasonforvisit related issues. Please take this time to grade our performance by completing the attached survey.
We look forward to hearing from you!
Thanks,
CPTS Staff
 
------=_NextPart_000_001A_01CE13D9.ED9885F0

There is nothing calling out this data to be in either the body or the html body of your message. I believe the format is more binary MAPI driven. What version of outlook are you using to use the oft.

Also one other consideration if you change your version of outlook or office in the future you might get screwed since it's so specific.

 

[thechazm]

Ok I got it to work. See the attached database. I removed a lot of your custom code but using it this way worked like a champ. You can add all your items you want to after.

The code looks like this:

Function workwithoft()
Dim intUSL As Integer
Dim olApp As Outlook.Application
Dim objMail As Outlook.MailItem
Dim strRFV As String
strRFV = "!This is just a test!"
Set olApp = New Outlook.Application
Set objMail = olApp.CreateItemFromTemplate("C:\1\test.oft")
objMail.Body = Replace(objMail.Body, "reasonforvisit", strRFV)
With objMail
    objMail.SentOnBehalfOfName = "(E-Mail Removed)"
    .To = "[EMAIL="test@test.com"]test@test.com[/EMAIL]"
    .Subject = "2 CPTS Customer Survey"
    .Display
End With
'Clean up
Set olApp = Nothing
Set objMail = Nothing
 
End Function

 

[A1CLowe]

I'm getting an "application-defined or object-defined error" on objMail.body = Replace(objMail.body, "reasonforvisit", strRFV)

This is on the Mapi DB that its happening on, I haven't put it in mine yet.

 

[thechazm]

What version of office do you have loaded and is this a windows machine or a mac?

 

[A1CLowe]

Office 2007 on a windows machine

 

[thechazm]

It sounds like the reference got broken. Go into your visual basic editor and look at the module and at the top select tools--->References and look at the outlook reference. Try deselecting and then reselecting it in your references.