I am cheating a bit because I am not trying to solve a problem originating from Access. I am a retired teacher and many years ago wrote some VB code within Excel to automatically send emails from Outlook.
This was to automate the cover and invigilation problem that all schools face.
The school has now contacted me saying that they have moved up to Office 13 and the code no longer works. My VB is now rusty (almost non-existent) so I need some help. The code worked in Office 2003 and possibly also 2007.
Could someone point me in the direction that might solve the problem?
I suspect that the problem lies somewhere in this part of the macro:
-----------------------------------------------------------------------------------
If Range(teachercell) <> "" Then
'Create the outlook session.
Set MyOlApp = CreateObject("Outlook.Application")
'Create appointment
Set myitem = MyOlApp.CreateItem(olAppointmentItem)
With myitem
If Len(Range(absentcell)) > 3 Then
' invigilation
myitem.Body = "Dear " & Range(teachercell) & "," & vbCrLf & vbCrLf & "On - " & MyDate & " - " & Range(periodcell) & ", you have been " _
& vbCrLf & "allocated an invigilation in - " & Range(roomcell) & " - " _
& vbCrLf & " " _
& vbCrLf & "This invigilation has been automatically entered into your calendar." _
& vbCrLf & "Note - if you click on 'Accept', this message will disappear from your mailbox!" _
& vbCrLf & "It is advisable to print this message as a reminder." _
& vbCrLf & "To set an automatic reminder, go into your calendar, locate the invigilation and double click on it." _
& vbCrLf & "You can then set a suitable value for the 'Alarm' interval." _
& vbCrLf & " " _
& vbCrLf & "Thanks, " _
& vbCrLf & " " _
& vbCrLf & findname
Else
' cover
myitem.Body = "Dear " & Range(teachercell) & "," & vbCrLf & vbCrLf & "On - " & MyDate & " - " & Range(periodcell) & ", you have a cover for " & Range(absentcell) _
& " in " & Range(roomcell) _
& vbCrLf & " " _
& vbCrLf & "This cover period has been automatically entered into your calendar." _
& vbCrLf & "Note - if you click on 'Accept', this message will disappear from your mailbox!" _
& vbCrLf & "It is advisable to print this message as a reminder." _
& vbCrLf & "To set an automatic reminder, go into your calendar, locate the cover and double click on it." _
& vbCrLf & "You can then set a suitable value for the 'Alarm' interval." _
& vbCrLf & " " _
& vbCrLf & "Thanks, " _
& vbCrLf & " " _
& vbCrLf & findname
End If
myitem.MeetingStatus = olMeeting
If Len(Range(absentcell)) > 3 Then
myitem.Subject = "Invigilation"
myitem.Location = Range(roomcell)
Else
myitem.Subject = "Cover Period"
myitem.Location = "Room " & Range(roomcell)
End If
thetime = Range(timecell)
myitem.Start = thetime
myitem.Duration = Range(durationcell)
'Add the To recipient to the message
Set myRequiredAttendee = myitem.Recipients.Add(Range(teacheraddress))
myRequiredAttendee.Type = olRequired
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
If Not objOutlookRecip.Resolve Then
objOutlookMsg.Display
End If
Next
.Send
End With
Set MyOlApp = Nothing
Set myitem = Nothing
End If
This was to automate the cover and invigilation problem that all schools face.
The school has now contacted me saying that they have moved up to Office 13 and the code no longer works. My VB is now rusty (almost non-existent) so I need some help. The code worked in Office 2003 and possibly also 2007.
Could someone point me in the direction that might solve the problem?
I suspect that the problem lies somewhere in this part of the macro:
-----------------------------------------------------------------------------------
If Range(teachercell) <> "" Then
'Create the outlook session.
Set MyOlApp = CreateObject("Outlook.Application")
'Create appointment
Set myitem = MyOlApp.CreateItem(olAppointmentItem)
With myitem
If Len(Range(absentcell)) > 3 Then
' invigilation
myitem.Body = "Dear " & Range(teachercell) & "," & vbCrLf & vbCrLf & "On - " & MyDate & " - " & Range(periodcell) & ", you have been " _
& vbCrLf & "allocated an invigilation in - " & Range(roomcell) & " - " _
& vbCrLf & " " _
& vbCrLf & "This invigilation has been automatically entered into your calendar." _
& vbCrLf & "Note - if you click on 'Accept', this message will disappear from your mailbox!" _
& vbCrLf & "It is advisable to print this message as a reminder." _
& vbCrLf & "To set an automatic reminder, go into your calendar, locate the invigilation and double click on it." _
& vbCrLf & "You can then set a suitable value for the 'Alarm' interval." _
& vbCrLf & " " _
& vbCrLf & "Thanks, " _
& vbCrLf & " " _
& vbCrLf & findname
Else
' cover
myitem.Body = "Dear " & Range(teachercell) & "," & vbCrLf & vbCrLf & "On - " & MyDate & " - " & Range(periodcell) & ", you have a cover for " & Range(absentcell) _
& " in " & Range(roomcell) _
& vbCrLf & " " _
& vbCrLf & "This cover period has been automatically entered into your calendar." _
& vbCrLf & "Note - if you click on 'Accept', this message will disappear from your mailbox!" _
& vbCrLf & "It is advisable to print this message as a reminder." _
& vbCrLf & "To set an automatic reminder, go into your calendar, locate the cover and double click on it." _
& vbCrLf & "You can then set a suitable value for the 'Alarm' interval." _
& vbCrLf & " " _
& vbCrLf & "Thanks, " _
& vbCrLf & " " _
& vbCrLf & findname
End If
myitem.MeetingStatus = olMeeting
If Len(Range(absentcell)) > 3 Then
myitem.Subject = "Invigilation"
myitem.Location = Range(roomcell)
Else
myitem.Subject = "Cover Period"
myitem.Location = "Room " & Range(roomcell)
End If
thetime = Range(timecell)
myitem.Start = thetime
myitem.Duration = Range(durationcell)
'Add the To recipient to the message
Set myRequiredAttendee = myitem.Recipients.Add(Range(teacheraddress))
myRequiredAttendee.Type = olRequired
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
If Not objOutlookRecip.Resolve Then
objOutlookMsg.Display
End If
Next
.Send
End With
Set MyOlApp = Nothing
Set myitem = Nothing
End If
