错误-2147352571类型不匹配:无法强制参数值

时间:2014-02-04 19:05:29

标签: forms ms-access scripting

在尝试为2010 Access Form编写Visual Basic代码时,我正在努力解决上述错误。我正在努力确保员工和团队负责人获得相同的电子邮件。当我第一次编写代码时,它最初工作。我已经在表单中添加了“发布日期”,但没有添加到电子邮件中。我试图将问题日期添加到脚本中,但这不起作用。我已经从表单和脚本中删除了发布日期。任何帮助将不胜感激:

Private Sub cmdEmail_Click()
Dim objOutlook As Object
Dim objMailItem As Object
Const olMailItem As Integer = 0
 Dim objMailItem1 As Object
 Const olMailItem1 As Integer = 0
 Set objOutlook = CreateObject("Outlook.Application")
 Set objMailItem = objOutlook.CreateItem(olMailItem)
 Set objMailItem1 = objOutlook.CreateItem(olMailItem1)

 Dim strPathAttach As String
 On Error GoTo err_Error_handler
 'set receipient, you can use a DLookup() to retrieve your associate Email address
 objMailItem.To = DLookup("Email_ID", "dbo_Noble_Associates", "[Fullname]='" & Me.cboAssociate & "'")
 objMailItem1.To = DLookup("Email_ID", "dbo_TeamLeads$", "[Fullname]='" & Me.txtTeamLead & "'")
 'set subject with text and Form values
 objMailItem.Subject = "Attendance Violation " & Me.cboAssociate
 objMailItem1.Subject = "Attendance Violation " & Me.cboAssociate
 'set body content with text and Form values etc.
 objMailItem.htmlBody = "Date of Occurrence: " & Format(Me.Occurrence_Date, "mm/dd/yyyy")     & "<br>" & "Attendance Points: " & Me.CboType & "<br>" & "Total Points: " & Me.txtTotalpoints     & "<br>" & "Notes: " & Me.txtNotes
 objMailItem1.htmlBody = "Date of Occurrence: " & Format(Me.Occurrence_Date, "mm/dd/yyyy")     & "<br>" & "Attendance Points: " & Me.CboType & "<br>" & "Total Points: " & Me.txtTotalpoints & "<br>" & "Notes: " & Me.txtNotes

 ' display email
 ' objMailItem.Display
 ' sending mail automaticly
 objMailItem.Send
 objMailItem1.Send
 Set objOutlook = Nothing
 Set objMailItem = Nothing
 Set objMailItem1 = Nothing

 exit_Error_handler:
 On Error Resume Next
 Set objOutlook = Nothing
 Set objMailItem = Nothing
 Set objMailItem1 = Nothing

 Exit Sub

 err_Error_handler:
 Select Case Err.Number
 'trap error 287
 Case 287
 MsgBox "Canceled by user.", vbInformation
 Case Else
 MsgBox "Error " & Err.Number & " " & Err.Description
 End Select
 Resume exit_Error_handler
 End Sub
 Private Sub CheckEmail_Click()
 End Sub
 Private Sub cmdSaveandNew_Click()
 If Me.txtOccurrence_Date & "" = "" Then
 MsgBox "Please enter the date."
 Me.txtOccurrence_Date.SetFocus
 Exit Sub
 ElseIf Me.cboAssociate & "" = "" Then
 MsgBox "Please select the associate's name."
 Me.cboAssociate.SetFocus
 Exit Sub
 ElseIf Me.txtPoints & "" = "" Then
 MsgBox "Please enter the number of Points."
 Me.txtPoints.SetFocus
 Exit Sub
 End If

 If Me.CheckEmail = True Then
 cmdEmail_Click
 End If
 DoCmd.Close acForm, Me.Name
 End Sub
 Private Sub cmd_Cancel_Click()
 Me.Undo
 DoCmd.Close acForm, Me.Name

 End Sub
 Private Sub cboassociate_AfterUpdate()
 Me.txtTeamLead.Value = Me.cboAssociate.Column(1)
 End Sub
 Private Sub cboFullname_AfterUpdate()
 Me.txtCurrentpoints.Value = Me.cbofullname.Column(1)
 End Sub

 Private Sub CboType_AfterUpdate()
 Me.txtPoints.Value = Me.CboType.Column(1)
 End Sub

我愿意接受任何建议。

0 个答案:

没有答案