msaccess, html, vba

Help!  I've never attempted to us HTML before.   :)  I need to send the loop through users (a field in the table contains their email) and provide a  table with only their data set only,.  I'm stuck on the looping through where the html will capture only their records, create a table with only for that user and email via outlook.

Here is my code:
Function END_Late_Email()

Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim strHTML As String
Dim strTo As String
Dim rst As DAO.Recordset
Dim cnt As Long


 
    Set rst = CurrentDb.OpenRecordset("SELECT * FROM END_Late_EmailsFRsv_q")
  
    
    If Not rst.EOF Then
      
      strTo = rst.Fields("EmpEmail")
        
        strHTML = strHTML & "<table border=""1"" align=""Left"">" & vbCrLf
        For cnt = 0 To rst.Fields.Count - 2
        strHTML = strHTML & " <b> <th bgColor ='#5D7B9D'> " & rst(cnt).Name & "</th> " & vbCrLf

        Next cnt
    
    Do While Not rst.EOF
    
        

        strHTML = strHTML & "  <tr>" & vbCrLf
        For cnt = 0 To rst.Fields.Count - 2
        strHTML = strHTML & "    <td>" & rst(cnt) & "</td>" & vbCrLf
        Next cnt
        strHTML = strHTML & "  </tr>" & vbCrLf
        rst.MoveNext
    Loop
        strHTML = strHTML & "</table>" & vbCrLf
    End If
      
      
    strHTML = "<p>EB" & strHTML
    strHTML = "<p><p> Thank You," & strHTML
    strHTML = "4.  Be prepared with evidence to support causes outside of supplier's control.<br><br>" & strHTML
    strHTML = " 3.  Provide corrective action, and any other relevant facts for all causes within supplier's control.</p>" & strHTML
    strHTML = "&nbsp &nbsp b.  The secondary cause is the second longest time element which prevented meeting END.</p>" & strHTML
    strHTML = " &nbsp &nbsp a.  The primary cause is the longest time element which prevented meeting END.</p>" & strHTML
    strHTML = " 2.  Identify the primary and secondary causes which prevented meeting END.</p>" & strHTML
    strHTML = "1.  Confirm delivery date is correctly recorded.  If not, please provide POD.</p>" & strHTML
    strHTML = "<p> Last week, the following RPM PO line items were delivered late to END.  For this part, please confirm we have the correct delivery date and disregard items 2-4 below due to PO placement after END <b><u>by Tuesday early morning</b></u>, please:</p>" & strHTML
    strHTML = "<p>Hello,</p>" & strHTML

   
   
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)
    
    With OutMail
        .To = strTo
        .CC = ""
        .BCC = ""
        .Subject = "RPM Late Deliveries"
        .BodyFormat = olFormatHTML
        .HTMLBody = strHTML
        .Send
    End With
    

    Set rst = Nothing
    Set dbs = Nothing
      
    'rst.Close
    Set OutMail = Nothing
    Set OutApp = Nothing
   

End Function

Open in new window

Sheli Van LaninghamAsked:
Who is Participating?
 
Nick67Commented:
So, to my mind this doesn't look right
Set rst = CurrentDb.OpenRecordset("SELECT END_late_EmailsFRsv_q.*, END_late_EmailsFRsv_q.SBM From emailsv, END_late_EmailsFRsv_q WHERE (((END_late_EmailsFRsv_q.SBM)=[emailsv].[SBM]));")

You want rsEmails!SomeFieldThatMakesSense at the end of it
Something like
Set rst = CurrentDb.OpenRecordset("SELECT END_late_EmailsFRsv_q.*, END_late_EmailsFRsv_q.SBM From emailsv, END_late_EmailsFRsv_q WHERE END_late_EmailsFRsv_q.SBM= " & rsEmails!SBM, dbOpenDynaset)

Now
strTo = rsEmail.Fields("Email") should be outside the Do While Not rst.EOF
(That's an awkward construction by-the-by replaceable by Do Until)
And  rsEmail.Fields("Email") while workable syntax is usually seen as
rsEmail!Email
You'll get Intellisense for that construction, so you can mis-capitalize it and watch it self-correct if your spelling is right.
The way you've wrote it, you'd best be spelling correctly!

One assumes that there is a field named 'email' in Emailsv
Test what's there

'email table
Set rsEmails = CurrentDb.OpenRecordset("SELECT * FROM Emailsv", dbOpenDynaset)
rsEmails.MoveLast
rsEmails.MoveFirst

msgbox rsEmails.recordscount & " " rsEmails.Email

Msgbox is your friend!
0
 
NorieVBA ExpertCommented:
How are you stuck?

Is the email not coming out as expected?
0
 
Nick67Commented:
Given what I posted to your other question, are you still looking to pursue this one?
Have look here about the ins and outs of firing up Outlook automation without polluting your whole procedure with
On Error Resume Next
http://www.experts-exchange.com/articles/17466/Properly-open-Outlook-as-an-Application-object-in-VBA.html

Some of what doesn't quite look copasetic here is in your pseudo-coding
It should look like

'fire up Outlook
'grab a recordset
'movelast movefirst to populate it
'start looping
'create a message
'address and subject it
'switch to HTMLBody
'build up the HTML-compliant string
'assign the string to the body
'while you can try .Send, I've found that Outlook security can make that painful.
'Have the user click the send
'loop to the mext email
'msgbox done!
'clean up objects

Your present loop is only creating a single mail message
Was that the intent?
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
Sheli Van LaninghamAuthor Commented:
Nick67, since I already had this working, I thought I'd stay with it.  It's just that I can't find the right place to set the loop to create each message based on the email for that record.  Right now it is sending the complete table set to one email.  What I want to do is have it send the records that are populated with the corresponding email address.
0
 
Nick67Commented:
Right.
I can see that.
Look at your loop.
You have only one!

So you need two, one within the other
'fire up Outlook
Dim rsEmails as recordset
set rsEmails = CurrentDb.OpenRecordset("some query or Select that gets the email addresses an a value to feed into rsDetails", dbOpenDynaset)
Dim rsDetails as recordset

rsEmails.movefirst
do until rsemails.eof = true
    set rsDetails = CurrentDb.OpenRecordset("Some query that gets details where some PK = " & rsEmails!SomeUniqueIdentifier,  dbOpenDynaset)
    'build your HTML
    rsDetails.MoveFirst
    do until rsDetails.eof = true
        'working through fields and records building html -- or knocking stuff to Excel, saving as HTML and textstreaming the result back here
         rsDetails.movenext
  loop
    'Build your MailItem
    'close rsDetails
    rsEmails.movenext
loop
0
 
Helen FeddemaCommented:
See my recent Access Archon article on creating emails (both Plain Text and HTML) from Access.  Here is a link for downloading the article and sample database:

http://www.helenfeddema.com/Files/accarch240.zip

and here is a screen shot of an HTML email generated from this database:

HTML Email from Access
0
 
Sheli Van LaninghamAuthor Commented:
Nick, thanks for all your help.  I'm still struggling here...I get stuck at the Email moveNext, because it is not populating my StrTo with the emailrecordset.  Something is not in the right place here still...can you take a look again, please?

Function END_Late_Email()

Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim strHTML As String
Dim strTo As String
Dim rst As DAO.Recordset
Dim cnt As Long
Dim rsEmails As DAO.Recordset

'email table
Set rsEmails = CurrentDb.OpenRecordset("SELECT * FROM Emailsv", dbOpenDynaset)

rsEmails.MoveFirst
Do Until rsEmails.EOF = True

'detail table
Set rst = CurrentDb.OpenRecordset("SELECT END_late_EmailsFRsv_q.*, END_late_EmailsFRsv_q.SBM From emailsv, END_late_EmailsFRsv_q WHERE (((END_late_EmailsFRsv_q.SBM)=[emailsv].[SBM]));")
'details recordset
rst.MoveFirst
Do Until rst.EOF = True

'****build HTML
    
    If Not rst.EOF Then
       
        strHTML = strHTML & "<table border=""1"" align=""Left"">" & vbCrLf
        For cnt = 0 To rst.Fields.Count - 16
        strHTML = strHTML & " <b> <th bgColor ='#5D7B9D'> " & rst(cnt).Name & "</th> " & vbCrLf

        Next cnt
    
    Do While Not rst.EOF
  
        
        strHTML = strHTML & "  <tr>" & vbCrLf
        For cnt = 0 To rst.Fields.Count - 2
        strHTML = strHTML & "    <td>" & rst(cnt) & "</td>" & vbCrLf
        Next cnt
        strHTML = strHTML & "  </tr>" & vbCrLf
        rst.MoveNext
    Loop
        strHTML = strHTML & "</table>" & vbCrLf
    End If
      

    strHTML = "<p>Erick Byrd" & strHTML
    strHTML = "<p><p> Thank You," & strHTML
    strHTML = "4.  Be prepared with evidence to support causes outside of supplier's control.<br><br>" & strHTML
    strHTML = " 3.  Provide corrective action, and any other relevant facts for all causes within supplier's control.</p>" & strHTML
    strHTML = "&nbsp &nbsp b.  The secondary cause is the second longest time element which prevented meeting END.</p>" & strHTML
    strHTML = " &nbsp &nbsp a.  The primary cause is the longest time element which prevented meeting END.</p>" & strHTML
    strHTML = " 2.  Identify the primary and secondary causes which prevented meeting END.</p>" & strHTML
    strHTML = "1.  Confirm delivery date is correctly recorded.  If not, please provide POD.</p>" & strHTML
    strHTML = "<p> Last week, the following RPM PO line items were delivered late to END.  For this part, please confirm we have the correct delivery date and disregard items 2-4 below due to PO placement after END <b><u>by Tuesday early morning</b></u>, please:</p>" & strHTML
    strHTML = "<p>Hello,</p>" & strHTML

'****end HTML build

strTo = rsEmail.Fields("Email")
rst.MoveNext
Loop
   


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)
    
    With OutMail
        .To = strTo
        .CC = ""
        .BCC = ""
        .Subject = "RPM Late Deliveries"
        .BodyFormat = olFormatHTML
        .HTMLBody = strHTML
        .Send
    End With
    

rst.Close
rsEmails.MoveNext
Loop

    Set rst = Nothing
    Set dbs = Nothing
      

    Set OutMail = Nothing
    Set OutApp = Nothing
 
End Function

Open in new window

0
 
Sheli Van LaninghamAuthor Commented:
Thanks, Nick!  Due to your help I was able to get my code working!!   And Helen, I couldn't use your code because of company restrictions on our email (I couldn't get it to work when sending outside of my company), but it is a great solution if I am only using emails inside the company and will probably use it in the future!

Thanks all!!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.