Get email addresses from table

[pld60]

Now that my first question was answered I move on to the next.

I have this code to send an email

Private Sub Request_Click()
Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim strbody As String
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)
On Error Resume Next
    With OutMail
 
 
    .Body = "There is a Transport available on," & vbNewLine & Me.TBtransportdate.Value & " at " & Me.TBtransporttime.Value _
    & " for " & Me.TBDuration.Value & " Hours." & vbNewLine & "If you are available for this transport please reply." & vbNewLine _
    & "Transport # " & Me.TBID.Value & vbNewLine & "In your reply please enter your name and the number of the Transport." _
    & vbNewLine & "Transports will be awarded in the order of those that respond."
 
 
    .Subject = "Available Transport"
    .To = emailaddress
    .SendUsingAccount = OutApp.Session.Accounts.Item(2)
    .Send
 
 
End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
  DoCmd.Close
End Sub

Works great.

Now my issue is that I need to send this to all the contacts in a table.

Table name is EmailTest, Field name is email. Enter the email address from the field name into the .To = line

hope this makes sense?

 

[Ranman256]

I have a form with a listbox of emails.
I click the send button and it loops thru the list sending the report.(combo pick)

For I = 0 to lstEmail.listcount -1
    VEmail = lstEmail.dataitem(I)
   LstEmail = vEmail

  Docmd.sendobject acReport, acFormatPDF, cboRpt, vEmail....,
Next

 

[RogerH]

use DAO or ADO (google them) to set an object reference to the table,

then its a do ... loop to loop through the records and *similar* code to your button to send mail

 

[Cronk]

Indeed, loop through a recordset, as I suggested in my response to the OP's previous thread.

 

[pld60]

Cronk, do you have a link to that thread?

I have found lots of info about looping through a recordset, but I can not figure out how to add that to my code above. Or how to reference the recordset on my .To = line

 

[Ranman256]

You don't need dao. You are in access.

 

[Grumm]

I prefer DAO over ADO. I don't understand why you say that it is not needed...

Dim dbs As DAO.Database
Dim rsSQL As DAO.Recordset
Dim strSQL As String

Set dbs = CurrentDb

'Open a snapshot-type Recordset based on an SQL statement
strSQL = "SELECT * FROM Table1 WHERE Field2 = 33"
Set rsSQL = dbs.OpenRecordset(strSQL, dbOpenSnapshot)

How can you do this without dao ? (I am also in access)

 

[RogerH]

I prefer DAO over ADO. I don't understand why you say that it is not needed...

Dim dbs As DAO.Database
Dim rsSQL As DAO.Recordset
Dim strSQL As String

Set dbs = CurrentDb

'Open a snapshot-type Recordset based on an SQL statement
strSQL = "SELECT * FROM Table1 WHERE Field2 = 33"
Set rsSQL = dbs.OpenRecordset(strSQL, dbOpenSnapshot)

How can you do this without dao ? (I am also in access)

You do? I prefer ADO (fewer lines)

Dim objIdxStatus as Object
Set objIdxStatus = CurrentDb.OpenRecordset("tblIndexStatus")
with objIdxStatus
     .movefirst
     ....

And YES you need it.

 

[Grumm]

OpenRecordset("table") is actually DAO...
If you used ado you would need a connection string. Something like this :

    Dim rs As New ADODB.Recordset
    Dim strSql As String
    
    strSql = "SELECT * FROM Table1 WHERE Field2 = 33"
    rs.Open strSql, CurrentProject.Connection
    
    Do While Not rs.EOF

        rs.MoveNext
    Loop
    
    rs.Close
    Set rs = Nothing

I asked my question after reading this :

You don't need dao. You are in access.

 

[Cronk]

pld60

Cronk, do you have a link to that thread?

This is the thread you started. This is where I made reference to looping through a record set.
http://www.access-programmers.co.uk/forums/showthread.php?t=285531

dim rst as recordset
set rst = currentdb.openrecordset("SELECT Email from YourTableName")
if rst.recordcount >0
rst.movefirst
do while not rst.eof
strTo = strTo & ";" & rst!Email
rst.movenext
loop
endif
rst.close:set rst = nothing

objmsg.to = strTo

Glumm. Ranman
ADO vs DAO is a bit off topic

However, since Access 2007 the default is DAO (or more precisely Microsoft Access Database Engine Object Library or ACEDAO, a new version of DAO). A reference to this library is automatically added to any default new database so unlike ADO, you do not need to set a specific reference to the library. Note, if both references are set, it is important to disambiguate any object created based on those libraries ie dim rst = ado.recordset

 

[RogerH]

OpenRecordset("table") is actually DAO...
If you used ado you would need a connection string. Something like this :

    Dim rs As New ADODB.Recordset
    Dim strSql As String
    
    strSql = "SELECT * FROM Table1 WHERE Field2 = 33"
    rs.Open strSql, CurrentProject.Connection
    
    Do While Not rs.EOF

        rs.MoveNext
    Loop
    
    rs.Close
    Set rs = Nothing

I asked my question after reading this :

Not to thread-jack but:

I thought dimensioning a recordset and using a connection string *WAS* DAO.

But dimensioning an *object* and setting an object reference *WAS* ADO.

if not: (1) do I not know the difference between ADO and DAO? (possibly I learned it all so along ago I no longer remember.)

But (2) I have NO idea why all of you are doing that in 6 lines of code when I do it in 2 lines of code.

 

[pld60]

I have this code to send an email on a click event of a command button on a form. Need it to get the email from the Field email on the Table EmailTest.

Private Sub Command42_Click()
Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim strbody As String
    Dim MyDB As DAO.Database
    Dim MyRS As DAO.Recordset
    Dim MyRSSQL As String
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)
 
 
    strSQL = "SELECT * FROM EmailTest"
    Set rs = CurrentDb.OpenRecordset(strSQL)
 
With rs
 
    If Not .BOF And Not .EOF Then
 
        .MoveLast
        .MoveFirst
 
        While (Not .EOF)
 
 
            .MoveNext
 
        Wend
 
    End If
 
    .Close
On Error Resume Next
    With OutMail
 
 
    .Body = "Test," 
    .Subject = "Test"
    .To = "CurrentDb.OpenRecordset(strSQL)"
 
    .Send
 
 
End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
End With
End Sub

I am guessing that I am missing something, but it is not working. The code runs but no email is sent. Help please!

 

[RogerH]

Untested:

Private Sub SendEmailfromTable()

Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim strbody As String
    Dim objMyTable As Object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)
    Set objMyTable= CurrentDb.OpenRecordset(" ---- YOUR TABLE NAME HERE ")
 
If Not objMyTable.BOF And Not objMyTable.EOF Then
objMyTable.MoveFirst
DO While Not objMyTable.EOF 
     OutMail.Body = "Test," 
     OutMail.Subject = "Test"
     OutMail.To = ObjMyTable.---- EMAIL FIELD NAME HERE
     OutMail .Send
     objMyTable.MoveNext
 LOOP 
 
End If

set objMyTable = nothing
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

I don't think you can nest with statements, so I got rid of all that

 

[pld60]

Rogerh,

Thank you I seem to be making progress. When I placed your code and entered my table and field name I got a compile error. Invalid or unqualified reference at the .Send line

I made some changes to:

Private Sub Command42_Click()
Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim strbody As String
    Dim objMyTable As Object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)
    Set objMyTable = CurrentDb.OpenRecordset("EmailTest")
With OutMail
If Not objMyTable.BOF And Not objMyTable.EOF Then
objMyTable.MoveFirst
Do While Not objMyTable.EOF
 
     .Body = "I hope this is working."
     .Subject = "Test"
     .To = objMyTable.email
     .Send
     objMyTable.MoveNext
 Loop
End If
End With
Set objMyTable = Nothing
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

This work great as long as there is only one record in the table. With more than one record an email is sent to the first record then I get,

Run-time error '-1040973558(c1f4040a)':
The item has been moved or deleted.

Any ideas? using an on_Click event from a form.

 

[RogerH]

Private Sub Command42_Click()
Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim strbody As String
    Dim objMyTable As Object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)
    Set objMyTable = CurrentDb.OpenRecordset("EmailTest")
With OutMail
objMyTable.MoveFirst
Do While Not objMyTable.EOF
     .Body = "I hope this is working."
     .Subject = "Test"
     .To = objMyTable.email
     .Send
     objMyTable.MoveNext
 Loop
End With

Set objMyTable = Nothing
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

try that. I got rid of that if not eof and bof stuff. Although it might error if there are zero records in the table/

 

[pld60]

Still only sends the first record and then the same error.

 

[RogerH]

oh, I see , you're only creating one email.
moving the
Set OutMail = OutApp.CreateItem(olMailItem)
to inside the Do Loop would create a new message for each record in the table.

But is that what you want?

or do you want to send one email to all the addresses in the table?

In THAT case we should build one long To: string (or BCC if you don't want them to see each other's addresses) and send one email.

EDIT: WAIT as I re-read the code moving the Set command may conflict with the WITH statement. ( I never liked WITH statements)

 

[pld60]

RogerH, Yes it is the same message to everyone in the table.

 

[pld60]

I think a string, BCC

 

[RogerH]

Private Sub Command42_Click()
Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim strbody As String
    Dim objMyTable As Object
    Dim strEmailAdds as string
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)
    Set objMyTable = CurrentDb.OpenRecordset("EmailTest")

objMyTable.MoveFirst
strEmailAdds =objMyTable.email ' add 1st address

Do While Not objMyTable.EOF
  [B]    objMyTable.MoveNext
[/B]   strEmailAdds =strEmailAdds &";"  & objMyTable.email  'add other adds
 LOOP

With OutMail
     .Body = "I hope this is working."
     .Subject = "Test"
     .To = strEmailAdds  ' or .BCC = strEmailAdds
     .Send
End With


Set objMyTable = Nothing
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

EDIT: you have to do movenext BEFORE adding the 2nd address, or it puts the 1st adds twice