Creating Multiple Appointments from one form (1 Viewer)

[Integrate]

I have been putting together code from bits I have found online that will create an appointment in Outlook from a date field in my form.
My form has a number of dates and I need to create appointments for each one. Is there any way I can incorporate that into the existing code? Or will I need to add command buttons for each date?

The date fields are:
[Date Template Made]
[Date of Top Cut]
[Date of Bowl Cut]
(I know I have made the school girl error of spaces but have learnt my lesson)

I am a self taught user but I get stuck on loops. Any help/advise is much appreciated

Here is my code so far:

Private Sub CreateAppt_Click()
If Me.Dirty Then
        Me.Dirty = False
    End If
If Me.chkAddedtoOutlook = True Then
    MsgBox "This appointment has already been added to Microsoft Outlook", vbCritical
    ' Exit the procedure
    Exit Sub
Else
    ' Add a new appointment.
' Use late binding to avoid the "Reference" issue
Dim olapp As Object ' Outlook.Application
Dim olappt As Object ' olAppointmentItem

If isAppThere("Outlook.Application") = False Then
    ' Outlook is not open, create a new instance
    Set olapp = CreateObject("Outlook.Application")
Else
    ' Outlook is already open--use this method
    Set olapp = GetObject(, "Outlook.Application")
End If
    Set olappt = olapp.CreateItem(1) ' olAppointmentItem
    Start = Me.Date_Template_Made
    With olappt
    ' If There is no Start Date or Time on
    ' the Form use Nz to avoid an error
     
    ' Set the Start Property Value
    .Start = Nz(Me.Date_Template_Made, "") & " " & ("07:00")
    ' Set the End Property Value
    .End = Nz(Me.Date_Template_Made, "") & " " & ("17:00")
    .Subject = Nz(Me.Job_Name, vbNullString)
    .Body = Nz(Me.Notes, vbNullString)
    .Categories = "TemplateMade"
    
         .Save
    End With
    End If ' Release the Outlook object variables.
    Set olappt = Nothing
    Set olapp = Nothing    ' Set chkAddedToOutlook to checked
    Me.chkAddedtoOutlook = True
 
    ' Save the Current Record because we checked chkAddedToOutlook
    If Me.Dirty Then
        Me.Dirty = False
    End If
 
    ' Inform the user
    MsgBox "Appointment Added!", vbInformation
End Sub

 

[Roku]

You could do something like this:

Dim i As Integer
Dim ctl As Control
For i = 1 To 3
  Set ctl = Me.Controls(Choose(i, "[Date Template Made]", "[Date of Top Cut]", "[Date of Bowl Cut]"))
  Start = ctl
  With olappt
    ' If There is no Start Date or Time on the Form use Nz to avoid an error
    ' Set the Start Property Value
    .Start = Nz(ctl, "") & " " & ("07:00")
    ' Set the End Property Value
    .End = Nz(ctl, "") & " " & ("17:00")
    .Subject = Nz(Me.Job_Name, vbNullString)
    .Body = Nz(Me.Notes, vbNullString)
    .Categories = "TemplateMade"
    .Save
  End With
Next

As the loop steps through values 1 to 3, the Choose function points to the next control.

I'm puzzled by your logic and in particular your use of Me.Dirty. You check its status twice, with the comment

' Save the Current Record because we checked chkAddedToOutlook

- what do you expect to happen from this?

Logically, the code

If Me.Dirty Then
    Me.Dirty = False
End If

has the same effect as

Me.Dirty = False

If it was already false, it has no functional effect; if it was true, it's set false. Either way, the outcome is False. But why do this at all?

 

[Integrate]

Thanks for the code and the extra advise.

I have tried integrating your code with mine and then running it on it's own but I keep getting an error regarding an object (either error 424 or 91) on this line:

.Start = Nz(ctl, "") & " " & ("07:00")

I've tried all sort of fixes but I just don't know enough to figure this one out.

 

[Roku]

These two errors are to do with Object setting. I think it may be the names used in the Choose statement - I used the values you listed at the start of your post, but looking more closely at the code itself, I see you used

Me.Date_Template_Made

i.e. with underscores in place of the spaces.

If you change the Choose statement to

Choose(i, "Date_Template_Made", "Date_of_Top_Cut", "Date_of_Bowl_Cut")

it should fix these errors. Note that the brackets from my original example are removed.

As you observed yourself, it's not a good idea to have spaces in field names. It might be worth your while to fix that first, as it will make life easier in the long run.

 

[Integrate]

I have taken the spaces out of the field names as you suggested and removed the brackets [] but I am still getting the object error.

 

[Roku]

Please post your complete code as it is now. I suspect the value of ctl is not set correctly, but I can't say for sure.

Do you know which iteration of the loop fails?

 

[Integrate]

I tried adding the code in again and this time it worked! Well 1/3 did.
I am not getting errors. Yay. But only the third appointment, DateBowlCut, is being created.

Private Sub CreateAppt_Click()
        Me.Dirty = False
 
If Me.chkAddedtoOutlook = True Then
    MsgBox "This appointment has already been added to Microsoft Outlook", vbCritical
    ' Exit the procedure
    Exit Sub
Else
    ' Add a new appointment.
' Use late binding to avoid the "Reference" issue
Dim olapp As Object ' Outlook.Application
Dim olappt As Object ' olAppointmentItem
Dim i As Integer
Dim ctl As Control

If isAppThere("Outlook.Application") = False Then
    ' Outlook is not open, create a new instance
    Set olapp = CreateObject("Outlook.Application")
Else
    ' Outlook is already open--use this method
    Set olapp = GetObject(, "Outlook.Application")
End If
    
    Set olappt = olapp.CreateItem(1) ' olAppointmentItem
    For i = 1 To 3
    Set ctl = Me.Controls(Choose(i, "DateTemplateMade", "DateofTopCut", "DateBowlCut"))
    Start = ctl
    With olappt
    ' If There is no Start Date or Time on
    ' the Form use Nz to avoid an error
     
    ' Set the Start Property Value
    .Start = Nz(ctl, "") & " " & ("07:00")
    ' Set the End Property Value
    .End = Nz(ctl, "") & " " & ("17:00")
    .Subject = Nz(Me.Job_Name, vbNullString)
    .Body = Nz(Me.Notes, vbNullString)
    .Categories = "TemplateMade"
    
         .Save
    End With
    Next
    End If ' Release the Outlook object variables.
    Set olappt = Nothing
    Set olapp = Nothing    ' Set chkAddedToOutlook to checked
    Me.chkAddedtoOutlook = True
 
    ' Save the Current Record because we checked chkAddedToOutlook
      Me.Dirty = False
   
    ' Inform the user
    MsgBox "Appointment Added!", vbInformation
End Sub

 

[Roku]

Progress! That's good.

Have a look at the line

Set olappt = olapp.CreateItem(1) ' olAppointmentItem

in relationship to the loop. What's happening is that the appointment item is created, then the loop updates it three times. You need to create each item inside the loop.

 

[Integrate]

Legend!
I moved the For i statement to before that line and it worked!
Thank you so much

 

[Integrate]

Sorry, just one more question, is it possible to build in to the code that if a date is blank it will move to the next date?
I am sure it is simple but I am scared I might break the code if I do it wrong and end up back at square one

 

[Roku]

Don't be afraid to make changes! But DO make a copy of your working code so you can restore if it all goes wrong.

Try this:

    For i = 1 To 3
      Set ctl = Me.Controls(Choose(i, "DateTemplateMade", "DateofTopCut", "DateBowlCut"))
      Rem check value of current control
      If Not Nz(ctl, "") = "" Then
        Rem control is neither Null nor empty string - creaate appointment
        Set olappt = olapp.CreateItem(1) ' olAppointmentItem
        Start = ctl
        With olappt
          ' If There is no Start Date or Time on
          ' the Form use Nz to avoid an error
 
          ' Set the Start Property Value
          .Start = Nz(ctl, "") & " " & ("07:00")
          ' Set the End Property Value
          .End = Nz(ctl, "") & " " & ("17:00")
          .Subject = Nz(Me.Job_Name, vbNullString)
          .Body = Nz(Me.Notes, vbNullString)
          .Categories = "TemplateMade"
          .Save
        End With
      End If
    Next

I have put the appointment creation within an if block, having checked for null or empty string values.

 

[Integrate]

Brilliant, thank you so much for you help!
I've learnt heaps from this

 

[Roku]

Glad to have helped

 

[demicay2669]

I'm trying to incorporate this code into my db but im having a few issues. The latest is a run-time error 91. the line that highlights is in red. I don't have a checkbox so i just commented that out. But any help would be much appreciated.

Private Sub cmdCreateAppt_Click()
       Me.Dirty = False
 
'If Me.chkAddedtoOutlook = True Then
 '   MsgBox "This appointment has already been added to Microsoft Outlook", vbCritical
    ' Exit the procedure
  '  Exit Sub
'Else
    ' Add a new appointment.
' Use late binding to avoid the "Reference" issue
Dim olapp As Object ' Outlook.Application
Dim olappt As Object ' olAppointmentItem
Dim i As Integer
Dim ctl As Control
If fIsOutlookRunning = False Then Call OpenOutlook
    ' Outlook is not open, create a new instance
    'Set olapp = CreateObject("Outlook.Application")
'Else
    ' Outlook is already open--use this method
   ' Set olapp = GetObject(, "Outlook.Application")
'End If
    
    For i = 1 To 4
    Set ctl = Me.Controls(Choose(i, "ContainDueDate", "RootDueDate", "CorrectDueDate", "VerifDueDate"))
      Rem check value of current control
      If Not Nz(ctl, "") = "" Then
        'Rem control is neither Null nor empty string - creaate appointment
       [COLOR=red] Set olappt = olapp.CreateItem(1) ' olAppointmentItem[/COLOR]
        Start = ctl
        With olappt
          ' If There is no Start Date or Time on
          ' the Form use Nz to avoid an error
 
          ' Set the Start Property Value
          .Start = Nz(ctl, "") & " " & ("07:00")
          ' Set the End Property Value
          .End = Nz(ctl, "") & " " & ("17:00")
          .Subject = Nz(tblEmail.EmailSubject, vbNullString)
          .Body = Nz(tblEmail.EmailBody, vbNullString)
          .Categories = "TemplateMade"
          .Save
        End With
      End If
    Next
    Set olappt = Nothing
    Set olapp = Nothing    ' Set chkAddedToOutlook to checked
    'Me.chkAddedtoOutlook = True
 
    ' Save the Current Record because we checked chkAddedToOutlook
      Me.Dirty = False
   
    ' Inform the user
    MsgBox "Appointment Added!", vbInformation
End Sub

 

[Roku]

The error is because 'olapp' is not set. The two places where it was set in the original example are commented out.

Please provide some context for what you are trying to do, so we can provide more constructive help!

Are you putting this code in Access or Outlook?

 

[demicay2669]

I'm trying to have access automatically setup alerts/appts in Outlook based on four date fields in my form when they press a button. I had an error at those lines originally so I changed

[COLOR=black][FONT=Arial Narrow]If isAppThere("Outlook.Application") = False Then[/FONT][/COLOR]

that was origanlly there to match

If fIsOutlookRunning = False Then Call OpenOutlook

that I have in a module to open outlook to send an email.
Doing that gave an error first on the else line then on the first set olapp line

 'Set olapp = CreateObject("Outlook.Application")
'Else
    ' Outlook is already open--use this method
   ' Set olapp = GetObject(, "Outlook.Application")
'End If

 

[Roku]

Sorry for delayed response.

I think the syntax error on the 'Else' part is from the way you have laid out the code.

What you have added is structured like this:

If <condition> Then <true action>
Else
  <false action>
End If

Change this to

If <condition> Then 
  <true action>
Else
  <false action>
End If

VBA is picky about If-Then-Else structure. It will permit the entire condition to be on a single line or it will enforce multiple lines. So if you write:

If fIsOutlookRunning Then
  Rem  Outlook is already open--use this method
  Set olApp = GetObject(, "Outlook.Application")
Else
  Rem Outlook is not open, create a new instance
  Call OpenOutlook
  Set olApp = CreateObject("Outlook.Application")
End If

However, it might be better for your function 'fIsOutlookRunning' to return the object reference to olApp directly (rather than True/False) - without seeing the full logic, it's difficult to advise appropriately.

The object of the exercise to get olApp set with reference to a valid Outlook application. With that set, the remainder of the code should work (at least as far as this element is concerned).

 

[demicay2669]

I think that solved that error, but I am getting a run time error 424 on this line...

.Subject = Nz(tblEmail.EmailSubject)

I'm trying to reference one field in a table, because it is not on my form. I want it to pull the subject I have writing in that field of my table as it is. I looked all over the web and I guess I'm just not interpreting the syntax correctly.
Your help is very much appreciated.

 

[Roku]

Without knowing what tblEmail is, my guess is you need this syntax:

.Subject = Nz(tblEmail!EmailSubject)

this will work if tblEmail refers to a Recordset and EmailSubject is a field within that Recordset.

If tblEmail is, as it's name suggests, a table, then you will need something different. You would need to open the table (using a Recordset) and select the record you need, or you could use the DLookup function to get the required value directly.

 

[demicay2669]

Yes I am trying to refer to a table. The DLookup worked great. Thank you very much Roku.
I put it in like this:

.Subject = DLookup("[EmailSubject]", "tblEmail", "")