Solved VBA Code to generate email and place query result in Message body (1 Viewer)

A

Ashfaque

Student
Local time
Tomorrow, 00:29
Joined
Sep 6, 2004
Messages
894
I want my query result to appear in my email in a form of formatted html table using this code.
The email is being generated but query data is with attachment and not in the massage area.

Code: 
Dim strEmailSubject, strEmailText, olNewEmail As String
Dim strMailList, StrCC As String
StrCC = "int@gmail.com"
    strMailList = " Test@gmail.com"
    DoCmd.OpenQuery "Q_IntroNewEmp", acViewNormal, acEdit
    DoCmd.SelectObject acQuery, "Q_IntroNewEmp"
    DoCmd.RunCommand acCmdSelectAllRecords
    RunCommand acCmdCopy
    DoCmd.SendObject acSendQuery, "Q_IntroNewEmp", , "'strMailList", "XYZ@inatt.com", "INTRODUCTION TO NEW EMPLOYEE/(S)" & _
    "We are pleased to introduce following new employees recently hired to our growing INAT family:" & _
    "Good Luck and Best Regards," & _
    vbCr & vbCr & "Sincerely," & vbCr & vbCr & "AA" & vbCr & "Human Resources Dept.", True
    DoCmd.Close acQuery, "Q_IntroNewEmp", acSaveNo
    SendKeys "^v", True
    SendKeys "{ENTER}", True

Can anyone please help me out to place the query result at massage please? I need the result in mssg body of email in html. I have attached sample result.

Thanks,
 

Attachments

  • Email Sample.jpg
    Email Sample.jpg
    95.5 KB · Views: 71
Gasman

Gasman

Enthusiastic Amateur
Local time
Today, 19:59
Joined
Sep 21, 2011
Messages
14,310
Here is how I did it.
 

Attachments

  • Email with Sig VBA.txt
    13.6 KB · Views: 106
A

Ashfaque

Student
Local time
Tomorrow, 00:29
Joined
Sep 6, 2004
Messages
894
Thanks, Is this txt file format?
 
Gasman

Gasman

Enthusiastic Amateur
Local time
Today, 19:59
Joined
Sep 21, 2011
Messages
14,310
Yes?, just my code exported.
It does use Outlook automation and not sendobject though.
 
A

Ashfaque

Student
Local time
Tomorrow, 00:29
Joined
Sep 6, 2004
Messages
894
Wow...its plenty of code lines....Need to go thru all to understand step by step as I need few parts of it.

Anyway thanks Gasman....

I will revert back with answer..

Ashfaque
 
Gasman

Gasman

Enthusiastic Amateur
Local time
Today, 19:59
Joined
Sep 21, 2011
Messages
14,310
Yes, too big to post as code. :(
Just look at the construction of the html and variables.
Your logic will be pretty much the same I would have thought. :unsure:
Plus, you should understand what you are doing, if you do the work yourself.

If I was to trim it down, I might damage it, so it no longer works.
 
A

Ashfaque

Student
Local time
Tomorrow, 00:29
Joined
Sep 6, 2004
Messages
894
Thanks Gasman,:)

I tried with my code first and not able to sort it out as per my requirement. Then I read your code...it is lengthy and I assume that it is systematically presenting data from table to msg body in a special format. Some of the block of code I understand and some block of code are of not my concerned. Anyway.

Back to my original code, it is capable of creating email and I can set up To, CC, BCC. the only thing what I need is to place query generated data / direct tble data in the msg body area of the email as a start. Later on, I may further develop it like your...Columns, Lines, etc.

Is there other opinion to sort my issue?

Thanks,
 
A

Ashfaque

Student
Local time
Tomorrow, 00:29
Joined
Sep 6, 2004
Messages
894
Hi, :)

I got short and beautiful code on net thats almost to what I wanted to send the email. I have modified it according desire and it is working great
Code: 
Private Sub CmdSendIntro_Click()
Dim olApp As Object
Dim olItem As Variant
Dim db As DAO.Database
Dim rec As DAO.Recordset
Dim strQry As String
Dim aHead(1 To 9) As String
Dim aRow(1 To 9) As String
Dim aBody() As String
Dim lCnt As Long
Dim EndTxts As String

'Create the header row

aHead(1) = "Name"
aHead(2) = "Nationality"
aHead(3) = "Position"
aHead(4) = "Mobile"
aHead(5) = "Personal Email"
aHead(6) = "Joining Date"
aHead(7) = "Department"
aHead(8) = "Pic"
'aBody(lCnt) = "<HTML><body><table border='3'><tr><th>" & Join(aHead, "</th><th>") & "</th></tr>" & vbNewLine

lCnt = 1
ReDim aBody(1 To lCnt)
aBody(lCnt) = "" & "<br>"
aBody(lCnt) = aBody(lCnt) & "<HTML><body><table border='2'><tr><th>" & Join(aHead, "</th><th>") & "</th></tr>" & vbNewLine

'Create each body row
strQry = "SELECT T_IntroNewEmp.[EmpName], T_IntroNewEmp.Nationality,  T_IntroNewEmp.Position, T_IntroNewEmp.Mobile, " & _
"T_IntroNewEmp.PersonalEmail, T_IntroNewEmp.JoiningDate, T_IntroNewEmp.Department  " & _
 "FROM T_IntroNewEmp"

Set db = CurrentDb
Set rec = CurrentDb.OpenRecordset(strQry)

If Not (rec.BOF And rec.EOF) Then
    Do While Not rec.EOF
        lCnt = lCnt + 1
        ReDim Preserve aBody(1 To lCnt)
        aRow(1) = rec("EmpName")
        aRow(2) = rec("Nationality")
        aRow(3) = rec("Position")
        aRow(4) = Nz(rec("Mobile"), 0)
        aRow(5) = rec("PersonalEmail")
        aRow(6) = rec("JoiningDate")
        aRow(7) = rec("Department")
        
        aBody(lCnt) = "<tr><td>" & Join(aRow, "</td><td>") & "</td></tr>"
        rec.MoveNext
    Loop
End If

aBody(lCnt) = aBody(lCnt) & "</table></body></html>"

'create the email
Set olApp = CreateObject("Outlook.application")
Set olItem = olApp.CreateItem(0)
olItem.htmlbody = Join(aRow, vbNewLine)
olItem.htmlbody = Join(aBody, vbNewLine)

olItem.htmlbody = "Dear All," & "<br>" & "We are pleased to introduce  following new employee/(s) recently hired to our growing INAT family: "

olItem.To = "hr.relations@xxx.com"
olItem.Subject = "INTRODUCTION TO NEW EMPLOYEE/(S)"

olItem.htmlbody = olItem.htmlbody & "<br>"
aBody(lCnt) = aBody(lCnt) & "</table></body></html>"
olItem.htmlbody = olItem.htmlbody & Join(aBody, vbNewLine)

olItem.Display

'''''''Problem is below line that I need to display in my email bodytext at the end'''''''

EndTxts = "Please join me in welcoming them and wishing a very long and fruitful association with INAT." & "<br>" & "Good Luck" & "<br>" & "Regards" & "<br>" & _
"Sincerely," & "<br>" & "AA" & "<br>" & "Human Resources Dept."

End Sub

except last line that I need it to appear after the tbl data. (EndTxts).

Moreover, I want to change the font size thru code but it is not necessary.

Can someone please help?
 
A

Ashfaque

Student
Local time
Tomorrow, 00:29
Joined
Sep 6, 2004
Messages
894
Ashfaque said:
Hi, :)

I got short and beautiful code on net thats almost to what I wanted to send the email. I have modified it according desire and it is working great
Code: 
Private Sub CmdSendIntro_Click()
Dim olApp As Object
Dim olItem As Variant
Dim db As DAO.Database
Dim rec As DAO.Recordset
Dim strQry As String
Dim aHead(1 To 9) As String
Dim aRow(1 To 9) As String
Dim aBody() As String
Dim lCnt As Long
Dim EndTxts As String

'Create the header row

aHead(1) = "Name"
aHead(2) = "Nationality"
aHead(3) = "Position"
aHead(4) = "Mobile"
aHead(5) = "Personal Email"
aHead(6) = "Joining Date"
aHead(7) = "Department"
aHead(8) = "Pic"
'aBody(lCnt) = "<HTML><body><table border='3'><tr><th>" & Join(aHead, "</th><th>") & "</th></tr>" & vbNewLine

lCnt = 1
ReDim aBody(1 To lCnt)
aBody(lCnt) = "" & "<br>"
aBody(lCnt) = aBody(lCnt) & "<HTML><body><table border='2'><tr><th>" & Join(aHead, "</th><th>") & "</th></tr>" & vbNewLine

'Create each body row
strQry = "SELECT T_IntroNewEmp.[EmpName], T_IntroNewEmp.Nationality,  T_IntroNewEmp.Position, T_IntroNewEmp.Mobile, " & _
"T_IntroNewEmp.PersonalEmail, T_IntroNewEmp.JoiningDate, T_IntroNewEmp.Department  " & _
"FROM T_IntroNewEmp"

Set db = CurrentDb
Set rec = CurrentDb.OpenRecordset(strQry)

If Not (rec.BOF And rec.EOF) Then
    Do While Not rec.EOF
        lCnt = lCnt + 1
        ReDim Preserve aBody(1 To lCnt)
        aRow(1) = rec("EmpName")
        aRow(2) = rec("Nationality")
        aRow(3) = rec("Position")
        aRow(4) = Nz(rec("Mobile"), 0)
        aRow(5) = rec("PersonalEmail")
        aRow(6) = rec("JoiningDate")
        aRow(7) = rec("Department")
      
        aBody(lCnt) = "<tr><td>" & Join(aRow, "</td><td>") & "</td></tr>"
        rec.MoveNext
    Loop
End If

aBody(lCnt) = aBody(lCnt) & "</table></body></html>"

'create the email
Set olApp = CreateObject("Outlook.application")
Set olItem = olApp.CreateItem(0)
olItem.htmlbody = Join(aRow, vbNewLine)
olItem.htmlbody = Join(aBody, vbNewLine)

olItem.htmlbody = "Dear All," & "<br>" & "We are pleased to introduce  following new employee/(s) recently hired to our growing INAT family: "

olItem.To = "hr.relations@xxx.com"
olItem.Subject = "INTRODUCTION TO NEW EMPLOYEE/(S)"

olItem.htmlbody = olItem.htmlbody & "<br>"
aBody(lCnt) = aBody(lCnt) & "</table></body></html>"
olItem.htmlbody = olItem.htmlbody & Join(aBody, vbNewLine)

olItem.Display

'''''''Problem is below line that I need to display in my email bodytext at the end'''''''

EndTxts = "Please join me in welcoming them and wishing a very long and fruitful association with INAT." & "<br>" & "Good Luck" & "<br>" & "Regards" & "<br>" & _
"Sincerely," & "<br>" & "AA" & "<br>" & "Human Resources Dept."

End Sub

except last line that I need it to appear after the tbl data. (EndTxts).

Moreover, I want to change the font size thru code but it is not necessary.

Can someone please help?
Click to expand...
I just added like below:

olItem.htmlbody = olItem.htmlbody & Join(aBody, vbNewLine) & "Please join me in welcoming them and wishing a very long and fruitful association with INAT." & "<br>" & "Good Luck" & "<br>" & "<br>" & "Regards" & "<br>" & "<br>" & _
"Sincerely," & "<br>" & "AA" & "<br>" & "Human Resources Dept."

and it worked well.

Thanks to all..
 
You must log in or register to reply here.

Similar threads

B
Access VBA- Copy Query results into Table(in Access)--need help?
2
Replies
20
Views
3,412
Pat Hartman
P
U
Send emails to Unique users in Range
Replies
5
Views
1,167
Donnie1ben
D
M
Code to format email message body text
Replies
5
Views
671
pbaldy
pbaldy
A
Access VBA To Send Query Results to Outlook Email in Table Format
Replies
1
Views
1,458
arjun5381
A
D
Email with Looping Attachments and HTML Table
Replies
1
Views
1,871
MarkK
MarkK

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom