Use a Form Text Box for Email Address in VBA Function (1 Viewer)

tchble614

New member
Local time
Today, 08:19
Joined
Aug 19, 2019
Messages
3
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...

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 Function

Thank you in advance!
 
Last edited by a moderator:

pbaldy

Wino Moderator
Staff member
Local time
Today, 05:19
Joined
Aug 30, 2003
Messages
36,118
Instead of

olItem.To = "test@test.com"

try

olItem.To = Me.TextboxName

if that throws an error try

Dim strTo as String
strTo = Me.TextboxName
olItem.To = strTo
 

Mark_

Longboard on the internet
Local time
Today, 05:19
Joined
Sep 12, 2017
Messages
2,111
In your code, you have
Code:
[COLOR="Red"]olItem.display[/COLOR]
olItem.To = "test@test.com"
olItem.Subject = "CSN-Selkirk: Please Advise On The Below Orders"
olItem.htmlbody = Join(aBody, vbNewLine)
[COLOR="RoyalBlue"]olItem.display[/COLOR]

For the code I use, I only do the .Display AFTER I've finished with the Email.

Are you seeing two outlook messages when you do this?
 

tchble614

New member
Local time
Today, 08:19
Joined
Aug 19, 2019
Messages
3
Mark, I am only getting one email with the placement of the .display.

pbaldy, I tried the code you listed but it is telling me that I'm using an invalid use of ME.
 

tchble614

New member
Local time
Today, 08:19
Joined
Aug 19, 2019
Messages
3
I just figured it out but you led me down the right path pbaldy. Instead of;

Dim strTo as String
strTo = Me.TextboxName
olItem.To = strTo


I changed it slightly to;

Dim strTo As String
strTo = [Forms]![frm_Stockouts - Research]![Buyer Email]

olItem.To = strTo

Thank you for the help!
 

Gasman

Enthusiastic Amateur
Local time
Today, 12:19
Joined
Sep 21, 2011
Messages
14,051
Mark, I am only getting one email with the placement of the .display.

pbaldy, I tried the code you listed but it is telling me that I'm using an invalid use of ME.

Me only works if that code is in the form or report.?
If you have it in a module you would need to pass in the email address(es)

I generally only use functions when I need to return a value, however pass in the email address in your form when you call the function

Code:
 Stockouts_PO_Buyer_Email(Me.EmailTextBoxName)

in the function have
Code:
Function Stockouts_PO_Buyer_Email(strEmail as String)
....
olItem.To = strEmail

HTH
 

pbaldy

Wino Moderator
Staff member
Local time
Today, 05:19
Joined
Aug 30, 2003
Messages
36,118
I just figured it out but you led me down the right path pbaldy. Instead of;

Dim strTo as String
strTo = Me.TextboxName
olItem.To = strTo


I changed it slightly to;

Dim strTo As String
strTo = [Forms]![frm_Stockouts - Research]![Buyer Email]

olItem.To = strTo

Thank you for the help!

Happy to help! I misunderstood, thought the code was behind the form.
 

Users who are viewing this thread

Top Bottom