automate bulk email from access 2

[patrichek]

Hi I have this code that automates email. i would like to use an external txt file for the body of the email because my text is rather long. Is this possible, if so how would i change my current coding?
I'm using outlook express as the email client.

here's my current code

Private Sub cmdSend_Click()
    
  Dim dbs      As DAO.Database
    Dim rst      As DAO.Recordset
    Dim strSQL   As String
    Dim strEmail As String
    Dim strbody  As String
    
    ' Return reference to current database.
    Set dbs = CurrentDb
    'Find record to send report of
    strSQL = "SELECT EmailName " & _
             "FROM mytbl"
    
    Set rst = dbs.OpenRecordset(strSQL)
    
    strEmailname = ""
Do While Not rst.EOF
      strEmailname = strEmailname & rst("Emailname") & ";"
      rst.MoveNext
Loop
      strEmail = Left(strEmailname, Len(strEmailname) - 1)
      strbody = vbCrLf & vbCrLf & _
                "put the text you want in your email here"

    ' send email.
    DoCmd.SendObject acSendNoObject, "", acFormatTXT, strEmail, , , strHP, strbody, False

    Set dbs = Nothing
    Set rst = Nothing
End Sub

thanks!

 

[JerryKlmns]

No need to add any reference since we use late binding for the Microsoft Scripting Runtime library, to read the file c:\myEmailBody.txt as a text stream object.

Private Sub cmdSend_Click()
    
Dim dbs      As DAO.Database
Dim rst      As DAO.Recordset
Dim strSQL   As String
Dim strEmail As String
Dim strbody  As String
[b]
Dim fso As Object
Dim f As Object
Dim ts As Object
[/b]    
    ' Return reference to current database.
    Set dbs = CurrentDb
    'Find record to send report of
    strSQL = "SELECT EmailName FROM mytbl"
    
    Set rst = dbs.OpenRecordset(strSQL)
    
    strEmailname = ""
    Do While Not rst.EOF
      strEmailname = strEmailname & rst("Emailname") & ";"
      rst.MoveNext
    Loop
    strEmail = Left(strEmailname, Len(strEmailname) - 1)
[b]
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.GetFile("c:\myEmailBody.txt")
    Set ts = f.OpenAsTextStream(1, -2) '[green]ForReading, TristateUseDefault[/green]
    strbody = ts.ReadAll
    ts.Close
    Set ts = Nothing
    Set f = Nothing
    Set fso = Nothing
[/b]
    ' send email.
    DoCmd.SendObject acSendNoObject, "", acFormatTXT, strEmail, , , strHP, strbody, False
[b]
    rst.Close
    Set rst = Nothing
    Set dbs = Nothing
[/b]
End Sub

 

[patrichek]

thanks!

 

[patrichek]

Hi Again,
one last question on this code. What if my table doesn't have any email addresses in it? Is there a way for access to check before running the code or cancel and close?

thanks again, this works great!

 

[JerryKlmns]

Since you get your email addresses in a recordset then check to see if these properties EndOfFile (EOF) and BegginingOfFile (BOF) of the recordset return [blue]True[/blue]. If the do both, then your recordset returns not records (empty recordset).Then cancel everything and exit sub.

After the line

Set rst = dbs.OpenRecordset(strSQL)

add the following

If rst.BOF And rst.EOF Then
   rst.Close
   Set rst = Nothing
   Set dbs = Nothing
   Exit Sub
End If

 

[patrichek]

That worked perfect! I had to remove "exit sub" from the function but after that, all good!

one last thing, how do i add a subject line? I've searched for this but I'm not sure how and where to add the Dim strSubject As String?

thanks again!

 

[patrichek]

seems i spoke to soon. it works fine as long as there's an email address in the table, when i try to run it when the table is empty i get this error :
"object variable or with block variable not set" and " Do While Not rst.EOF" is highlighted.

 

[PHV]

Why did you remove the Exit Sub ?

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[patrichek]

Hi P,

I was getting "exit sub not allowed in function" error. If i remove exit sub the code will run as long as there are email addresses in the table.

here's my code again, with the "exit sub" included.

Option Compare Database

Function SendMail()
    
    Dim dbs      As DAO.Database
Dim rst      As DAO.Recordset
Dim strSQL   As String
Dim strEmail As String
Dim strbody  As String

Dim fso As Object
Dim f As Object
Dim ts As Object
    
    ' Return reference to current database.
    Set dbs = CurrentDb
    'Find record to send report of
    strSQL = "SELECT EmailName " & _
             "FROM email2infopromisedtbl"
    
    Set rst = dbs.OpenRecordset(strSQL)
    If rst.BOF And rst.EOF Then
   rst.Close
   Set rst = Nothing
   Set dbs = Nothing
Exit Sub
End If
    
    strEmailname = ""
    Do While Not rst.EOF
      strEmailname = strEmailname & rst("Emailname") & ";"
      rst.MoveNext
    Loop
    strEmail = Left(strEmailname, Len(strEmailname) - 1)

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.GetFile("\\ls-server\leads\scripts_etc\emailIP.txt")
    Set ts = f.OpenAsTextStream(1, -2) 'ForReading, TristateUseDefault
    strbody = ts.ReadAll
    ts.Close
    Set ts = Nothing
    Set f = Nothing
    Set fso = Nothing

    ' send email.
    DoCmd.SendObject acSendNoObject, "", acFormatTXT, strEmail, , , strHP, strbody, False

    rst.Close
    Set rst = Nothing
    Set dbs = Nothing

End Function

thanks!

 

[PHV]

Try Exit Function[/i] instead ...

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[patrichek]

works! thanks! now how to insert a subject in this email?

 

[PHV]

Move something in strHP ...

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[patrichek]

thanks! this finally did the trick! stars to you guys!

Function SendMail()
    
    Dim dbs      As DAO.Database
Dim rst      As DAO.Recordset
Dim strSQL   As String
Dim strEmail As String
Dim strbody  As String
Dim strESubject As String

Dim fso As Object
Dim f As Object
Dim ts As Object
    
    ' Return reference to current database.
    Set dbs = CurrentDb
    'Find record to send report of
    strSQL = "SELECT EmailName " & _
             "FROM email2infopromisedtbl"

    Set rst = dbs.OpenRecordset(strSQL)

    If rst.BOF And rst.EOF Then
   rst.Close
   Set rst = Nothing
   Set dbs = Nothing
Exit Function
End If
    
    strEmailname = ""
    Do While Not rst.EOF
      strEmailname = strEmailname & rst("Emailname") & ";"
      rst.MoveNext
    Loop
    strEmail = Left(strEmailname, Len(strEmailname) - 1)
    

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.GetFile("\\ls-server\leads\scripts_etc\emailIP.txt")
    Set ts = f.OpenAsTextStream(1, -2) 'ForReading, TristateUseDefault
    strbody = ts.ReadAll
    ts.Close
    Set ts = Nothing
    Set f = Nothing
    Set fso = Nothing
    strESubject = "Put your subject here"

    ' send email.
    DoCmd.SendObject acSendNoObject, "", acFormatTXT, strEmail, , , strESubject, strbody, False

    rst.Close
    Set rst = Nothing
    Set dbs = Nothing

End Function