Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1288
  • Last Modified:

VBA 2003-2007 Outlook HTMLBody Problems

Our office recently upgraded to MS Office 2007. This change however created some problems with existing VBA scripts. In particular ones used to automate emails from access. The code no longer inserts the entire body of the email, but only first instance MailOutLook.HTMLBody = "message".
Every subsequent paragraph is followed by MailOutLook.HTMLBody = MailOutLook.HTMLBody & "Additional info".
In the past this has reset MailOutLook.HTMLBody to include the previous string and the new one. However, in 2007 it will not reset MailOutLook.HTMLBody or include any of the additional strings.

Here is some sample code from the problem.
 
Dim MailOutLook As Outlook.MailItem

MailOutLook.HTMLBody = "Message"
MailOutLook.HTMLBody = MailOutLook.HTMLBody & "Table Headers"
Do Until rs.EOF
MailOutLook.HTMLBody = MailOutLook.HTMLBody & "Table column data"
rs.MoveNest
Loop
MailOutLook.HTMLBody = MailOutLook.HTMLBody & "Closing Remarks"

Open in new window


The code above is obviously a shortened version, but will only display the "Message" following MailOutLook.HTMLBody and not any of the tables or other paragraphs  further down. I can only assume that this has to do with some odd between the two versions of office, but I have no idea where to look or how to fix it.

Thanks,
0
Lee-H
Asked:
Lee-H
  • 5
  • 4
  • 3
  • +1
2 Solutions
 
ErezMorCommented:
without refferring to possible changes or the real cause of your problem (which i dont know), better coding approach would be building an entire string (or mail message in this case), and only then transporting it to outlook
so add
dim strMeessage as string
at the top, concatenate it all in to it (strMessage=strMessage & "bla bla bla..." works great)
then call outlook only once:
MailOutLook.HTMLBody = strMessage
0
 
David LeeCommented:
Hi, Lee-H.

There must be something else that's wrong.  Outlook 2007 does not handle the code you posted any differently than 2003.  A loop is a loop and concatenating a string is handled in exactly the same fashion.  Neither of those operations are specific to Outlook.  They are general operations of VBA.  I'd set a breakpoint at the beginning of the loop and step through it to see what's going on.
0
 
Lee-HAuthor Commented:
There is  a lot of stuff inside the code that I cant share, but when I get back to work on Monday I will remove all of the data that can't be shared and post the whole code. Thanks guys. I will also give the break a try.
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
conagramanCommented:
i doubt it's this simple but i noticed that your code might be misspelled.  

rs.MoveNest
* rs.MoveNext

i cant know if that was a mistake when copying to this site but thought id mention it.
if it is true that it is just a simple spelling error i would compile your database as well as correcting the spelling.
0
 
Lee-HAuthor Commented:
Okay very sorry for the delay. But I can only access this database at the office due to its sensitivity. Anyway, I took everything out of the original code that lends any hint as to the contents of the email and identities.
 This peice of code worked fine in 2003 and generated the entirety of the email. However, it now stops at MailOutLook.HTMLBody = "Dear " & FullName & ",<br><br>" and will not continue the loop from there.
Thanks,
Private Sub Command26_Click()

 Dim Recipient As String
 Dim Forward As String
 Dim Message As String
 Dim lblProject As String
 Dim rs As DAO.recordSet
 Dim db As database
 Dim sql As String
 Dim PIName As String
 Dim RecCount As Integer
 Dim p1 As String
 Dim p2 As String
 Dim p3 As String
 Dim p4 As String
 Dim p5 As String
 Dim p6 As String
 Dim p7 As String
 Dim p8 As String
 Dim p9 As String
 Dim Sname As String
 Dim FName As String
 Dim FullName As String
 Dim LName As String
 Dim EmailSubject As String
 Dim Iname As String
 
 
 Sname = Me.txtPIName
 
' Fname = Split(Sname, ",")
 'Replace(Sname, ",") = Fname
 'Fname = Replace(Sname, "*,", "")
 FName = Split(Sname, ",")(1)
 LName = Split(Sname, ",")(0)
 FullName = FName & " " & LName
 Iname = Left(FName, 2) & ". " & LName
 
 
    Dim appOutLook As Outlook.Application
    Dim MailOutLook As Outlook.MailItem
    Set appOutLook = CreateObject("Outlook.Application")
    Set MailOutLook = appOutLook.CreateItem(olMailItem)
    
PIName = Me.txtPIName
' SQL query to find which records belong to the specified PI
sql = "SELECT tblImport.[Child Flex Value], tblImport.[Child Value Description], [F&AGeneral].[FA Earned], [F&AGeneral].[FA Distrib], [F&AGeneral].PI, [F&AGeneral].[DEAN/DEPT], [F&AGeneral].OVPR FROM [F&AGeneral] INNER JOIN tblImport ON [F&AGeneral].Project = tblImport.[Child Flex Value] WHERE (((tblImport.[Child Pi S E mail Address])='" & Me.Email_address & "'));"

On Error Resume Next
' Email Recipients
Recipient = Me.Email_address
Forward = Me.cc_address & "; " & Me.cc2_address


'Open the recordset
Set db = CurrentDb
Set rs = db.OpenRecordset(sql)

' Mail Introduction
MailOutLook.HTMLBody = "Dear " & FullName & ",<br><br>"

' Message Body
p1 = "text"
p3 = "paragraph 2"
p4 = "paragraph 3"
p5 = "paragraph 3"
p6 = "paragraph 4"
p7 = "paragraph 5"
p8 = "paragraph 6"
p9 = "Final Paragraph"
p10 = "CONFIDENTIALITY NOTE" & Iname

' The following builds the body message.
MailOutLook.HTMLBody = MailOutLook.HTMLBody & p1 & "<br><br>" & p2 & "<br><br>" & p3 & "<br>" & "<DIR>" & p4 & "<br>" & p5 & "<br>" & p6 & "</DIR>" & "<br>" & p7


' Table Opening and Headers
MailOutLook.HTMLBody = MailOutLook.HTMLBody & "<font size='8'>" & "<table width=350 border=1 cellpadding=5 style= ' border-collapse:collapse; border-color:black; border-style:Solid; border-width: thin '><tr><th>Project:</th><th width='15%'> Description:</th><th>FY09 F&A</th><th>F&A to be Distributed</th><th>OVPR 25%</th><th width>Dean/Dept 10%</th><th width>PI 10%</th></tr>"
'Add Records to the tbale.
   Do Until rs.EOF
   
     MailOutLook.HTMLBody = MailOutLook.HTMLBody & _
                    "<tr><td align='center'><font size='-2'>" & rs![Child Flex Value] & "</font></td><td align='left'><font size='-2'>" & rs![Child Value Description] & "</font></td><td align='right'><font size='-2'>" & FormatCurrency(rs![FA Earned], 2, True, True, True) & "</font></td><td align='right'><font size='-2'>" & FormatCurrency(rs![FA Distrib], 2, True, True, True) & "</font></td><td align='right'><font size='-2'>" & FormatCurrency(rs!OVPR, 2, True, True, True) & "</font></td><td align='right'><font size='-2'>" & FormatCurrency(rs![Dean/Dept], 2, True, True, True) & "</font></td><td align='right'><font size='-2'>" & FormatCurrency(rs![pi], 2, True, True, True) & "</font></td></tr>"
    'MailOutLook.HTMLBody = MailOutLook.HTMLBody & "<tr><td>" & rs![Child Flex Value] & "</td><td>" & rs![Child Value Discription] & "</td><td>" & FormatNumber(rs![FA Earned], 2, True, True, True) & "</td><td>" & FormatNumber(rs![FA Distrib], 2, True, True, True) & "</td><td>" & rs!OVPR & "</td><td>" & rs![Dean/Dept] & "</td><td>" & rs!pi & "</td></tr>"

        rs.MoveNext
        Loop
rs.Close
db.Close

    
    
' Close the table
MailOutLook.HTMLBody = MailOutLook.HTMLBody & "</table>" & "</font>"


'Closing Notes
MailOutLook.HTMLBody = MailOutLook.HTMLBody & "<b><font size='-1'>" & p8 & "</font></b>" & "<br><br>" & p9 & "<br><br>" & Me.Rep_Name & ", " & Me.Rep_Title & "<br>" & "Sponsored Programs Accounting" & "<br>" & Me.Rep_Email & "<br>" & Me.Rep_Phone & "<br><br>" & "<font size='-2'>" & p10 & "</font>"

' Message Routing Information
    MailOutLook.Display
    MailOutLook.To = Recipient
    MailOutLook.CC = Forward
    MailOutLook.Subject = EmailSubject

DriverExit:
    On Error Resume Next
    Set MailOutLook = Nothing
    Set appOutLook = Nothing
    Exit Sub
    
End Sub

Open in new window

0
 
conagramanCommented:
is your database compiled?
0
 
David LeeCommented:
You say it stops and won't continue.  Are you getting an error message?  
0
 
Lee-HAuthor Commented:
Sorry let me clarify. The email opens, but it does not write anything past Dear First Name & Last Name,
There are several additional paragraphs that should populate when the script runs.
0
 
David LeeCommented:
Did you try the breakpoint I suggested?
0
 
conagramanCommented:
is your database compiled?
0
 
Lee-HAuthor Commented:
Yes the database is compiled, its running on a MS SQL server. I also tried the break point. I am going to try using strMessage=strMessage that ErezMor suggested. Perhaps if you use that loop first instead of the other that I was using it will work properly.
0
 
conagramanCommented:
try removing all of the "On Error Resume Next" comments
this might help point out where the problem is. also

as bluedevil already pointed out. changing to a string that is built dynamically isn't going to make a difference.
0
 
ErezMorCommented:
i'm sorry to defer, but i wouldnt underestimate the importance of good coding
it's nothing less than the first step to do before even considering anything else when trying to solve an obscure error
rewrite your code to build the whole string, only then send it (once) to outlook.
this is a simple and common task outlook automation provides AND many experts have enough experience in, should you still need more guidance
0
 
Lee-HAuthor Commented:
Thanks for the help this is exactly what I needed to do to make things work again. I am sorry I have been so busy running around fixing all of the other problems we have had with the upgrade that I barley had time to heed any of your advice. This is an inherited database and I would love to redo a lot of it but I harldey ever have a dull moment. Thanks again, all of you, your help was fantastic.
0

Featured Post

How to Use the Help Bell

Need to boost the visibility of your question for solutions? Use the Experts Exchange Help Bell to confirm priority levels and contact subject-matter experts for question attention.  Check out this how-to article for more information.

  • 5
  • 4
  • 3
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now