使用VBA从Access发送Outlook预约

时间:2017-05-26 14:56:21

标签: vba ms-access outlook

我目前有一个项目即将完成,但我已经陷入了最后的障碍。

我想要实现的是让Access向工程师发送电子邮件并在其Outlook日历中设置提醒。现在电子邮件已被分类,这只是日历提醒,这让我很难过。

我从https://access-programmers.co.uk/forums/showthread.php?t=209552找到了一些看起来正确的东西,所以我删除了我不需要的代码,这就是剩下的。

Option Compare Database

Sub Outlook()
Dim obj0App As Object
Dim objAppt As Object
Set obj0App = CreateObject("outlook.Application")
Set objAppt = obj0App.CreateItem(olAppointmentItem)

With objAppt
.requiredattendees = EmailAddy.Value
.optionalattendees = ASMail.Value
.subject = "Training booked for " & " " & QualificationEmail.Value
.Importance = 2 ' high
.Start = STdate.Value & "Starting at" & " " & StTime.Value
.End = Edate.Value
.Location = Location.Value
.Reminderminutesbeforestart = 20160 'reminder set for two weeks     before     the event
.Body = "Training for" & " " & [QualificationEmail] & "." & vbNewLine &     "Any changes to this arrangement will be emailed to you. You will     recieve any confirmation for bookings nearer the time."
.Meetingstatus = 1
.responserequested = True
.Save
.display
.send
MsgBox "Appointment sent"
End With

End Sub

当我测试代码时,我遇到的问题是.requiredattendee导致运行时错误424 Object Required。

如果有人能让我知道为什么VBA没有认识到必需和可选的与会者?

注意: 声明值的部分是; EmailAddy,ASMail,QualificationsEmail,STdate,StTime,Edate&地点。所有链接到Access数据库表单,使用文本框上的Dlookup,如下例所示。

=DLookUp("[Engineer Email]","[EngTrainForm]","'[Windows ID]=" & [Windoze] &     "'")
=[Forms]![Training_Admin]![Windows ID]
=DLookUp("[Area Of Work]","[EngTrainForm]","'[Windows ID]=" & [Windoze] &     "'")
=DLookUp("[ASM Email]","[EngTrainForm]","'[Area]=" & [Area] & "'")
=DLookUp("[OutlookMSG]![Qualification]","[OutlookMSG]","' [EngTrain]!    [Training Date Booked] =" & [EngDate] & "'")

当我尝试逐步执行olAppointmentItem = Empty时,添加尽可能多的信息,&整个代码停止在.requiredattendees = EmailAddy.Value引发运行时错误424,需要对象。

但是,如果我接下来添加了一个错误恢复,并且它已经运行了代码,我收到一封电子邮件,其中重要性作为正文详细信息(接受qualifiedEmail)。

监视列表中的.requiredattendees = EmailAddy.Value表示Expression没有在上下文中定义,上下文是OutlookCalander,Outlook。

1 个答案:

答案 0 :(得分:1)

经过更多的试验和错误之后,通过代码我发现它需要在Excel中进行更多声明,与Excel相比。如果有人想要更多信息,请访问以下代码:

Sub Outlook()
Dim obj0App As Object
Dim objAppt As Object
Dim EmailAddy As Object
Dim ASMail As Object
Dim QualificationEmail As Object
Dim STdate As Object
Dim StTime As Object
Dim Edate As Object
Dim Location As Object



Set obj0App = CreateObject("outlook.Application")
Set objAppt = obj0App.CreateItem(1) 'olAppointmentItem


With objAppt

.requiredattendees = Forms("EngTraining").EmailAddy.Value
.optionalattendees = Forms("EngTraining").ASMail.Value
.subject = "Training booked for " & " " &     Forms("EngTraining").QualificationEmail.Value
.Importance = 2 'high
.Start = Forms("EngTraining").STdate.Value & " " &     Forms("EngTraining").StTime.Value
.End = Forms("Engtraining").EngTrainsubform.EndDate.Value
'.Location = Location.Value
.ReminderMinutesBeforeStart = 20160 'reminder set for two weeks before     the event
.Body = "Training for" & " " &     Forms("EngTraining").QualificationEmail.Value     & "." & vbNewLine & "Any changes to this arrangement will be emailed to you.     You will recieve any confirmation for bookings nearer the time."
.Meetingstatus = 1
.responserequested = True
.Save
.display
.send
MsgBox "Appointment sent"
End With

End Sub

唯一尚未奏效的是位置,所以我需要对此有所了解,但现在大部分都有效。

相关问题