Continious Form: Use email field of all records to email

[hardhitter06]

Access 2003.

Hi Guys,

I have a continious form that displays a few fields of Vendor Information through a query search. One of these fields is "VendorCompanyEmail". Is there a way to code a button so that when it is clicked, all of the email fields from the records on the contnious form go into an outlook message (To: ).

I have this code currently set up, but it is only selecting the first record's email on the continious form:

Private Sub Command24_Click()
On Error GoTo Err_Command24_Click

Dim stDocName As String

stDocName = "frmVendorSearchEditCommodity"
' DoCmd.SendObject acReport, stDocName
DoCmd.SendObject acSendNoObject, stDocName, acFormatXLS, Me.VendorCompanyEmail, , , "", , True
Exit_Command24_Click:
Exit Sub

Err_Command24_Click:
MsgBox Err.Description
Resume Exit_Command65_Click

End Sub

Any ideas on how to tweak this to add all of them Email fields returned from the qry on the continious form?

PS The Button is located in the forms Footer.

 

[ezfriend]

Before sending to outlook, you can call a function to collect all recipients using recordset and return it back to your click

Private Sub Command24_Click()
    On Error GoTo Err_Command24_Click

    Dim stDocName As String

    stDocName = "frmVendorSearchEditCommodity"
    ' DoCmd.SendObject acReport, stDocName
    DoCmd.SendObject acSendNoObject, stDocName, acFormatXLS, GetAllEmailAddress, , , "", , True
Exit_Command24_Click:
    Exit Sub

Err_Command24_Click:
    MsgBox Err.Description
    Resume Exit_Command65_Click

End Sub

Private Function GetAllEmailAddress() as String

    Dim rs As Recordset
    Dim sRecipients As String
    
    Set rs = Me.Recordset
    sRecipients = ""

    rs.MoveFirst
        
    Do While rs.EOF = False
        If sRecipients <> "" Then
            sRecipients = sRecipients & ";"
        End If
        
        sRecipients = sRecipients & rs!Name & ""
        rs.MoveNext
    Loop
    
    Set rs = Nothing

    GetAllEmailAddress = sRecipients

End Function

 

[hardhitter06]

It's saying "Item not Found in this collection".

I'm wondering where I put my "VendorContactEmail" in the code so it knows what field to pull the addresses from?

 

[hardhitter06]

If EZ has me on the right path...can someone help me figure out what he was missn 4 this not to work? Thank you all in advance.

Josh

 

[ezfriend]

sRecipients = sRecipients & rs!Name & ""

shoud be

sRecipients = sRecipients & rs!vendorCompanyEmail & ""

 

[hardhitter06]

Yep that was it. Didn't even realize that's what you meant for me to Replace. I appreciate all of your help!!

 

[hardhitter06]

A new problem arose....sometimes Vendors will not have an email address so when we query Vendors by what they sell, this VendorCompanyEmail Field is blank. When this occurs, I am unable to use this button because the sequence of the code is broken when an email address is missing. The access message for this is "Unknown message recipients; the message was not sent."

When all the records from the search have an email address, this button works perfect.

My question is, what would I have to do with this code so that if, for example, Vendor 4/10 doesn't have an email address, that the code will ignore the missing data, and continue with Vendors 5 through 10 pulling each of their email addresses into outlook?

 

[hardhitter06]

Here is my exact code:

Private Sub Command24_Click()
On Error GoTo Err_Command24_Click

Dim stDocName As String

stDocName = "frmVendorSearchEditCommodity"
' DoCmd.SendObject acReport, stDocName
DoCmd.SendObject acSendNoObject, stDocName, acFormatXLS, GetAllEmailAddress, , , "", , True
Exit_Command24_Click:
Exit Sub

Err_Command24_Click:
MsgBox Err.Description
Resume Exit_Command24_Click

End Sub

Private Function GetAllEmailAddress() As String

Dim rs As Recordset
Dim sRecipients As String

Set rs = Me.Recordset
sRecipients = ""

rs.MoveFirst

Do While rs.EOF = False
If sRecipients <> "" Then
sRecipients = sRecipients & ";"
End If

sRecipients = sRecipients & rs!VendorCompanyEmail & ""

rs.MoveNext
Loop

Set rs = Nothing

GetAllEmailAddress = sRecipients

End Function

 

[ezfriend]

In the do while loop, you need to check to see if an email is actually exist.

Private Function GetAllEmailAddress() As String

Dim rs As Recordset
Dim sRecipients As String

Set rs = Me.Recordset
sRecipients = ""

rs.MoveFirst

Do While rs.EOF = False

   'this will add the email to the TO list only if there's an email 
   'otherwise you will get some thing like "firstemail;;;;;;;;lastemail@mail.com..." etc...

   If trim(rs!VendorCompanyEmail & "") <>"" then

       If sRecipients <> "" Then
             sRecipients = sRecipients & ";"
        End If

        sRecipients = sRecipients & rs!VendorCompanyEmail & ""

    End If

    rs.MoveNext
Loop

Set rs = Nothing

GetAllEmailAddress = sRecipients

End Function

 

[hardhitter06]

On the money...Thanks!