UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Send Appointment To Multiple Recipients From Access Query In Vba, Office 2013    
 
   
gelderr
post Mar 27 2020, 05:53 AM
Post#1



Posts: 4
Joined: 13-March 20



Hi all,

Does anyone know how to send an outlook appointment to multiple recipients from access query?
Below the simple vba code I currently use for one recipient (pretty new to this all)
The query I created only returns the email addresses of certain people within the company.

Query
CODE
SELECT Contactpersonen.Bedrijf, Contactpersonen.Categorie, Contactpersonen.[E-mailadres]
FROM Contactpersonen
WHERE (((Contactpersonen.Bedrijf) Like "COMPANY*" Or (Contactpersonen.Bedrijf) Like "Company*") AND ((Contactpersonen.Categorie)="Intern"));


VBA code
CODE
Option Compare Database

Private Sub CmdCreateAppointment_Click()

' Save record first to be sure required fields are filled.
DoCmd.RunCommand acCmdSaveRecord

Dim objOutlook          As Outlook.Application
Dim outMail             As Outlook.AppointmentItem
Dim myRequiredAttendee  As Outlook.recipient

Set outMail = Outlook.CreateItem(olAppointmentItem)

outMail.Subject = "Oplevering 1ste concept rapportage" & "; " & Forms![Projectgegevens]![Project Name]

outMail.Start = Me!OpleverDatumConcept1 & Space(1) & "11:00"
outMail.End = Me!OpleverDatumConcept1 & Space(1) & "12:00"
outMail.BusyStatus = olFree

outMail.MeetingStatus = olMeeting
Set myRequiredAttendee = outMail.Recipients.Add("test@test.com")  "I would like to have my query here"
    myRequiredAttendee.Type = olRequired

outMail.Display

End Sub


Thanks in advance
Go to the top of the page
 
DanielPineault
post Mar 27 2020, 06:07 AM
Post#2


UtterAccess VIP
Posts: 7,386
Joined: 30-June 11



welcome2UA.gif
I'd assume it would work the same way you deal with multiple e-mail recipients, so implement the technique found at https://www.devhut.net/2010/09/03/vba-send-...ook-automation/

Here a general idea of what I'm referring to (untested)
CODE
Private Sub CmdCreateAppointment_Click()
    Dim objOutlook            As Outlook.Application
    Dim outMail               As Outlook.AppointmentItem
    Dim myRequiredAttendee    As Outlook.recipient
    Dim db                    As DAO.Database
    Dim rs                    As DAO.Recordset
    Dim sSQL                  As String

    On Error GoTo Error_Handler

    ' Save record first to be sure required fields are filled.
    DoCmd.RunCommand acCmdSaveRecord

    Set db = CurrentDb
    sSQL = "SELECT Contactpersonen.Bedrijf, Contactpersonen.Categorie, Contactpersonen.[E-mailadres] " & vbCrLf & _
           "FROM Contactpersonen " & vbCrLf & _
           "WHERE (((Contactpersonen.Bedrijf) Like ""COMPANY*"" Or (Contactpersonen.Bedrijf) Like ""Company*"") AND ((Contactpersonen.Categorie)=""Intern""));"
    Set rs = db.OpenRecordset(sSQL, dbOpenSnapshot)

    Set outMail = Outlook.CreateItem(olAppointmentItem)
    outMail.Subject = "Oplevering 1ste concept rapportage" & "; " & Forms![Projectgegevens]![Project Name]
    outMail.start = Me!OpleverDatumConcept1 & Space(1) & "11:00"
    outMail.end = Me!OpleverDatumConcept1 & Space(1) & "12:00"
    outMail.BusyStatus = olFree
    outMail.MeetingStatus = olMeeting
    With rs
        If .RecordCount <> 0 Then
            If Trim(Nz(![E-mailadres], "") & vbNullString) <> "" Then
                Set myRequiredAttendee = outMail.Recipients.Add(![E-mailadres])
                myRequiredAttendee.Type = olRequired
            End If
        End If
    End With
    outMail.display

Error_Handler_Exit:
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    Set myRequiredAttendee = Nothing
    Set outMail = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: CmdCreateAppointment_Click" & vbCrLf & _
           "Error Description: " & Err.Description, _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Sub


A couple general comments:
  • I would urge you to switch over to using Late Binding techniques.
  • Never use special characters when naming things (field, objects, VBA variables, ...) so no spaces, hyphens, ... So instead of 'E-mailadres' use 'EmailAdress'
  • Always use error handling in all your VBA procedures to control how errors are handled and possibly log them, e-mail the admin, ...
  • Instead of doing Space(1) & "12:00" in which you are calling another function, it is simpler and more efficient to simply do " 12:00"
  • You should add checks for controls that you are using to populate properties with to avoid error if there are empty.
  • You may like to look over https://www.devhut.net/2017/04/20/access-be...shooting-steps/ for many more tips

--------------------
Daniel Pineault (2010-2020 Microsoft MVP, UA VIP, EE Distinguished Expert 2018)
Professional Help: https://www.cardaconsultants.com
Free MS Access Code, Tips, Tricks and Samples: https://www.devhut.net

* Design should never say "Look at me". It should always say "Look at this". -- David Craib
* A user interface is like a joke, if you have to explain it, it's not that good! -- Martin LeBlanc


All code samples, demonstration databases, links,... are provided 'AS IS' and are to be used at your own risk! Take the necessary steps to check, validate ...(you are responsible for your choices and actions)
Go to the top of the page
 
gelderr
post Mar 27 2020, 07:49 AM
Post#3



Posts: 4
Joined: 13-March 20



Hi Daniel,

Thanks for the quick reply and your recommendations for writing vba code. I will look into that.

Your code works, but it only returns the first e-mail address record from the query.
Is there an easy way of concatenating all of the e-mail addresses?
Go to the top of the page
 
DanielPineault
post Mar 27 2020, 08:08 AM
Post#4


UtterAccess VIP
Posts: 7,386
Joined: 30-June 11



Sorry, I forgot the loop. crazy.gif

CODE
Private Sub CmdCreateAppointment_Click()
    Dim objOutlook            As Outlook.Application
    Dim outMail               As Outlook.AppointmentItem
    Dim myRequiredAttendee    As Outlook.recipient
    Dim db                    As DAO.Database
    Dim rs                    As DAO.Recordset
    Dim sSQL                  As String

    On Error GoTo Error_Handler

    ' Save record first to be sure required fields are filled.
    DoCmd.RunCommand acCmdSaveRecord

    Set db = CurrentDb
    sSQL = "SELECT Contactpersonen.Bedrijf, Contactpersonen.Categorie, Contactpersonen.[E-mailadres] " & vbCrLf & _
           "FROM Contactpersonen " & vbCrLf & _
           "WHERE (((Contactpersonen.Bedrijf) Like ""COMPANY*"" Or (Contactpersonen.Bedrijf) Like ""Company*"") AND ((Contactpersonen.Categorie)=""Intern""));"
    Set rs = db.OpenRecordset(sSQL, dbOpenSnapshot)

    Set outMail = Outlook.CreateItem(olAppointmentItem)
    outMail.Subject = "Oplevering 1ste concept rapportage" & "; " & Forms![Projectgegevens]![Project Name]
    outMail.start = Me!OpleverDatumConcept1 & Space(1) & "11:00"
    outMail.end = Me!OpleverDatumConcept1 & Space(1) & "12:00"
    outMail.BusyStatus = olFree
    outMail.MeetingStatus = olMeeting
    With rs
        If .RecordCount <> 0 Then
            Do While Not .EOF
                If Trim(Nz(![E-mailadres], "") & vbNullString) <> "" Then
                    Set myRequiredAttendee = outMail.Recipients.Add(![E-mailadres])
                    myRequiredAttendee.Type = olRequired
                End If
                .MoveNext
            Loop
        End If
    End With
    outMail.display

Error_Handler_Exit:
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    Set myRequiredAttendee = Nothing
    Set outMail = Nothing
    Exit Sub

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: CmdCreateAppointment_Click" & vbCrLf & _
           "Error Description: " & Err.Description, _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Sub

--------------------
Daniel Pineault (2010-2020 Microsoft MVP, UA VIP, EE Distinguished Expert 2018)
Professional Help: https://www.cardaconsultants.com
Free MS Access Code, Tips, Tricks and Samples: https://www.devhut.net

* Design should never say "Look at me". It should always say "Look at this". -- David Craib
* A user interface is like a joke, if you have to explain it, it's not that good! -- Martin LeBlanc


All code samples, demonstration databases, links,... are provided 'AS IS' and are to be used at your own risk! Take the necessary steps to check, validate ...(you are responsible for your choices and actions)
Go to the top of the page
 
gelderr
post Mar 27 2020, 09:19 AM
Post#5



Posts: 4
Joined: 13-March 20



It says 'Loop without Do'
I cant figure out where to place the Do.

Another question about the SQL statement. Wouldn't it be more practical to use the Name of the Query? instead of the full SQL statement?
Go to the top of the page
 
DanielPineault
post Mar 27 2020, 09:30 AM
Post#6


UtterAccess VIP
Posts: 7,386
Joined: 30-June 11



But there is a Do While Not .EOF line? and it compiles fine for me? iconfused.gif
Not sure what to say.



QUOTE
Another question about the SQL statement. Wouldn't it be more practical to use the Name of the Query? instead of the full SQL statement?

If you have a query, then yes, you can simply use that instead of hard coding the SQL Statement in the manner I've. Either, Or. It is up to you.
CODE
Set rs = db.OpenRecordset("NameOfYourQuery", dbOpenSnapshot)

--------------------
Daniel Pineault (2010-2020 Microsoft MVP, UA VIP, EE Distinguished Expert 2018)
Professional Help: https://www.cardaconsultants.com
Free MS Access Code, Tips, Tricks and Samples: https://www.devhut.net

* Design should never say "Look at me". It should always say "Look at this". -- David Craib
* A user interface is like a joke, if you have to explain it, it's not that good! -- Martin LeBlanc


All code samples, demonstration databases, links,... are provided 'AS IS' and are to be used at your own risk! Take the necessary steps to check, validate ...(you are responsible for your choices and actions)
Go to the top of the page
 
gelderr
post Mar 27 2020, 09:57 AM
Post#7



Posts: 4
Joined: 13-March 20



Oops missed the Do While Not .EOF line

It all works well know thanks.gif
Go to the top of the page
 


Custom Search


RSSSearch   Top   Lo-Fi    11th July 2020 - 12:11 AM