Hello,
I am new to Access World but would greatly appreciate some help with an issue I am having.
I am also by no means an expert with VBA coding but am definitely learning a lot.
I am trying to automate an email that has a table in the body based on a query. The query is filtered by the current record in a user form. Everything works great except for the email address. I need it to include an email address based off a text box in that same user form. I can get the code to work with a simple email address, but I can't figure out how to point to the form's text box for the address. Here is my code...
Thank you in advance!
I am new to Access World but would greatly appreciate some help with an issue I am having.
I am also by no means an expert with VBA coding but am definitely learning a lot.
I am trying to automate an email that has a table in the body based on a query. The query is filtered by the current record in a user form. Everything works great except for the email address. I need it to include an email address based off a text box in that same user form. I can get the code to work with a simple email address, but I can't figure out how to point to the form's text box for the address. Here is my code...
Code:
Function Stockouts_PO_Buyer_Email()
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 12) As String
Dim aRow(1 To 12) As String
Dim aBody() As String
Dim lCnt As Long
Dim prm As DAO.Parameter
Dim qdf As DAO.QueryDef
'Create the header row
aHead(1) = "Part #"
aHead(2) = "Part Description"
aHead(3) = "PO #"
aHead(4) = "Release #"
aHead(5) = "PO Line #"
aHead(6) = "Date Ordered"
aHead(7) = "Need By Date"
aHead(8) = "Promise Date"
aHead(9) = "Shipment Qty"
aHead(10) = "Qty Due"
aHead(11) = "Ship To"
aHead(12) = "Ship From"
lCnt = 1
ReDim aBody(1 To lCnt)
aBody(lCnt) = "<HTML><body><table border='2'><tr><th>" & Join(aHead, "</th><th>") & "</th></tr>"
'Create each body row
strQry = "SELECT * From qry_Stockouts - Open PO Email Report"
Set db = CurrentDb
Set qdf = db.QueryDefs("qry_Stockouts - Open PO Email Report")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next
Set rec = qdf.OpenRecordset(dbOpenDynaset, dbSeeChanges)
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("Part #") & ""
aRow(2) = rec("Part Description") & ""
aRow(3) = rec("PO #") & ""
aRow(4) = rec("Release #") & ""
aRow(5) = rec("PO Line #") & ""
aRow(6) = rec("Date Ordered") & ""
aRow(7) = rec("Need By Date") & ""
aRow(8) = rec("Promise Date") & ""
aRow(9) = rec("Shipment Qty") & ""
aRow(10) = rec("Qty Due") & ""
aRow(11) = rec("Ship To") & ""
aRow(12) = rec("Ship From") & ""
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.display
olItem.To = "test@test.com"
olItem.Subject = "CSN-Selkirk: Please Advise On The Below Orders"
olItem.htmlbody = Join(aBody, vbNewLine)
olItem.display
End FunctionThank you in advance!
Last edited by a moderator:
