Email mutliple based on dynamic

[Elmobram22]

Hi all,

I'm after creating a button which will allow me to email my staff a specific file. Each staff member has a file for each month with their timesheet. I'm going to build a form with two variables. Year and month. Once you have chosen them press the button and it will email out the individual files to each email. So for example once i have chosen my variables it would find and attach...

//server/timesheets/(var)year/(var)month/[LastName]&", "&[FirstName].doc

For each employee who is currently active. I know how to do most of this just not how to send each individually with a single click rather than choosing each person on eafter another.

Cheers,

Paul

 

[Minty]

Your file-name can't include a comma - it's an illegal character !

Show us your existing code to send one email - we can then show you how to adapt it to loop through all your recipients. We will also need to know the name of the table with your employees in it and what field holds their email address.

 

[Elmobram22]

Set myOlApp = CreateObject("Outlook.Application")
Set myItem = myOlApp.CreateItem(olMailItem)
Dim strPath As String

strPath = "\\server\resident_wsrp\WSRP (" & [pbLastName] & " " & [pbFirstName] & " - " & [pbDay].Column(1) & "-" & [pbMonth].Column(1) & "-" & [pbYear].Column(1) & ")\12 Reports and Administration\Quarterly Review\Quarterly Review " & [Combo16] & ".doc"

If strPath <> "" Then

Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)

With MailOutLook
.To = [Combo37].Column(3)
.cc = [Combo43].Column(3) & ", " & [Combo45].Column(3)
.Subject = "Quartely Review"
.htmlBody = "Hi " & [pbFKcsu].Column(3) & "," & "<br>" & "<br>" _
& "Please find attached " & [pbFirstName] & " " & [pbLastName] & "'s quarterly review." & "<br>" & "<br>" _
& "Kind regards,"
.Attachments.Add (strPath)
.Display
End With
Else
MsgBox "No file matching " & strPath & " found. Please make sure you selected a review period." & vbCrLf & _
"Processing terminated."
Exit Sub
End If

End Sub

 

[Elmobram22]

This is what I have used for a similar purpose but where I pull the data from selections on the form. The table is tblStaff and the fields FirstName, LastName and email would be what I would use.

 

[Minty]

Okay - you just need to get your staff details and loop around - something like

Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim sSql As String
Dim sFirst as String
Dim sLast as String
DIm sEmail as String

sSql = "SELECT FirstName, LastName , email " 
sSql = sSql & "FROM tblStaff "
sSql = sSql & "WHERE [COLOR="seagreen"]enter your selection criteria here[/COLOR] ;"

Set rst = db.OpenRecordset(sSql, dbOpenSnapshot)
If rst.RecordCount > 0 Then
	rst.MoveFirst
	Do While Not rst.EOF
		sFirst = rst.Fields("FirstName")
		sLast = rst.Field("LastName")
		sEmail = rst.Fields("email")
	
	[COLOR="SeaGreen"]'Put your email coding in here using the sLast sFirst and sEmail fields 
	[/COLOR]
	
		rst.MoveNext
	Loop
End If	
rst.Close
Set rst = Nothing

 

[Elmobram22]

Private Sub Command6_Click()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim sSql As String
Dim sFirst As String
Dim sLast As String
Dim sEmail As String

sSql = "SELECT FirstName, LastName , email, LeftAV "
sSql = sSql & "FROM tblStaff "
sSql = sSql & "WHERE [LeftAV] = no;"

Set rst = db.OpenRecordset(sSql, dbOpenSnapshot)
If rst.RecordCount > 0 Then
rst.MoveFirst
Do While Not rst.EOF
sFirst = rst.Fields("FirstName")
sLast = rst.Field("LastName")
sEmail = rst.Fields("email")

Set myOlApp = CreateObject("Outlook.Application")
Set myItem = myOlApp.CreateItem(olMailItem)
Dim strPath As String

strPath = "\\server\TIMESHEETS\" & [List0] & "\" & [Combo4].Column(3) & " " & [List0] & " " & [LastName] & " " & [FirstName] & ".doc"

If strPath <> "" Then

Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)

With MailOutLook
.To = sEmail
.Subject = "Timesheet"
.HTMLBody = "Hi " & [FirstName] & "," & "<br>" & "<br>" _
& "Please find attached your timesheet for [combo 4].Column(2)" & "<br>" & "<br>" _
& "Kind regards,"
.Attachments.Add (strPath)
.Display
End With
Else
MsgBox "No file matching " & strPath & " found. Please make sure you selected a review period." & vbCrLf & _
"Processing terminated."
Exit Sub
End If


rst.MoveNext
Loop
End If
rst.Close
Set rst = Nothing
End Sub

I've got this? Any ideas?

 

[Minty]

Okay - you need to remove the premature exit if there is no file. Please use code tags and indent you code to make it easier to read. I've adjusted it to use the current loop record.

Is LeftAV a text field or yes/no - and if you are getting an error what is it?

Private Sub Command6_Click()
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    Dim sSql As String
    Dim sFirst As String
    Dim sLast As String
    Dim sEmail As String

    sSql = "SELECT FirstName, LastName , email, LeftAV "
    sSql = sSql & "FROM tblStaff "
    sSql = sSql & "WHERE [COLOR="Red"][LeftAV] = no[/COLOR];"

    Set rst = db.OpenRecordset(sSql, dbOpenSnapshot)
    If rst.RecordCount > 0 Then
        rst.MoveFirst
        Do While Not rst.EOF
            sFirst = rst.Fields("FirstName")
            sLast = rst.Field("LastName")
            sEmail = rst.Fields("email")

            Set myOlApp = CreateObject("Outlook.Application")
            Set myItem = myOlApp.CreateItem(olMailItem)
            Dim strPath As String

            strPath = "\\server\TIMESHEETS\" & [List0] & "\" & [Combo4].Column(3) & " " & [List0] & " " & sLast & " " & sFirst & ".doc"

            If strPath <> "" Then

                Set appOutLook = CreateObject("Outlook.Application")
                Set MailOutLook = appOutLook.CreateItem(olMailItem)

                With MailOutLook
                    .To = sEmail
                    .Subject = "Timesheet"
                    .HTMLBody = "Hi " & sFirst & "," & "<br>" & "<br>" _
                                & "Please find attached your timesheet for [combo 4].Column(2)" & "<br>" & "<br>" _
                                & "Kind regards,"
                    .Attachments.Add (strPath)
                    .Display
                End With
           
            End If

            rst.MoveNext
        Loop
    End If
    rst.Close
    Set rst = Nothing
End Sub

 

[Elmobram22]

It is a yes/no box.

getting runtime error 91

object variable not set

Set rst = db.OpenRecordset(sSql, dbOpenSnapshot) for this

 

[Minty]

Ooops - sorry untested code - you need to add

set db = currentdb 'before referring to
Set rst = db.OpenRecordset(sSql, dbOpenSnapshot)

 

[Elmobram22]

Nice one!!! Works like a dream!!!!

 

[Minty]

Glad to help - I would suggest removing the spaces from your time sheet document name, and maybe using the StaffID number as a more unique way of identifying people. What happens when you employ 2 John Doe's ?

 

[Elmobram22]

Good call. I'll give it a go