可以发送电子邮件，但我一直收到此错误。以前这不是问题，代码工作正常，我能够更新表字段DateEmailSent，但现在无法更新该字段。这只有在我创建了另一个表单之后才发生，可能是该表单中的代码影响了此处的代码。
Option Compare Database
Function GenerateEmail(MySQL As String)
On Error GoTo Exit_Function:
Dim oOutLook As Outlook.Application
Dim oEmailItem As Mailitem
Dim currentDate As Date
currentDate = Date
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset(MySQL)
'MsgBox rs.RecordCount
If rs.RecordCount > 0 Then
rs.MoveFirst
' MsgBox rs!Email
Do Until rs.EOF
If IsNull(rs!Email) Then
rs.MoveNext
Else
If oOutLook Is Nothing Then
Set oOutLook = New Outlook.Application
End If
Set oEmailItem = oOutLook.CreateItem(olMailitem)
With oEmailItem
.To = rs!Email
.CC = "josleasecollection@jos.com.sg"
.Subject = "End of Lease Product Collection Notification - " & rs!IDATender & " " & rs!PONumber & " CUSTOMER NAME: " & rs!AgencyName
.Body = "Dear Customer, " & vbCr & vbCr & _
"Notification of End of Lease Collection" & vbCr & _
"This is to inform you that leasing product(s) for PO #" & rs!PONumber & " will be expiring on " & rs!DueDate & vbCr & vbCr & _
"For a smooth and seamless collection process, you are required to: " & vbCr & _
" - To appoint a single contact point (Name, email and mobile contacts) for coordination purposes." & vbCr & _
" - To make verifications on the lease items for collection" & vbCr & _
" - To consolidate lease equipment & allocate holding are for onsite work purposes." & vbCr & _
" - To provide site clearance access if there are entry restrictions." & vbCr & _
" - To remove any additional parts (i.e. RAM, Additional HD, Graphic cards) installed in the lease equipment that is not part of the lease contract and BIOS password lock." & vbCr & _
" - To sign off all necessary asset & collection forms upon validations." & vbCr & vbCr & _
"Important Terms: " & vbCr & _
" 1. Lease equipment must be return in full and good working condition (with the exception of fair wear & tear)." & vbCr & _
" For Desktop, items to be collected with main unit as follows:" & vbCr & _
" - Power Adapter/Cable, Keyboard, Mouse" & vbCr & vbCr & _
" For Notebook, items to be collected with main unit as follows:" & vbCr & _
" - Power Adapter, Carrying case, Mouse" & vbCr & vbCr & _
" For Monitor, items to be collected with main unit as follows:" & vbCr & _
" - VGA Cable" & vbCr & vbCr & _
" 2. Any loss of lease equipment, you are required to immediately inform JOS and we will advise the relevant procedures." & vbCr & _
" 3. Collection must be completed no later than 14 days after the expiry of lease. We reserve the right to impose a late return fees (calculated on a daily basis) for any lease equipment." & vbCr & _
" 4. JOS will send in onsite engineers for asset verification and assist you. If onsite engineers are not available, JOS will provide a handbook for hard disk removal before collection, to which you shall immediately conduct the hard disk removal at your end." & vbCr & _
" 5. JOS shall not be held liable for any non-removal of any additional parts." & vbCr & _
" 6. JOS shall be indemnified in the event that collection is unsuccessful by the termination date due to the default or unreasonable delay caused by the customer. " & vbCr & _
" Appreciate for your acknowledgement by replying to josleasecollection@jos.com.sg by " & currentDate
.Send
rs.Edit
rs!dateemailsent = Date
rs.Update
End With
Set oEmailItem = Nothing
Set oOutLook = Nothing
rs.MoveNext
End If
Loop
Else
End If
这是我创建的新表单的代码。
Option Compare Database
Private Sub btnUpdateEmail_Click()
On Error GoTo Exit_UpdateEmail
Email_Update:
Dim db As DAO.Database
Dim qdf As QueryDef
Dim sql As String
Set db = CurrentDb()
Set qdf = db.QueryDefs("qryUpdateEmail")
sqlString = "UPDATE Company SET Company.Email = '" & Me.txtNewEmail & "' WHERE Company.ContractNumber = '" & Me.txtContractNumber & "' "
qdf.sql = sqlString
If Nz(Me.txtContractNumber, "") = "" Then
MsgBox "Please enter a contract number"
Resume Exit_Update
ElseIf Nz(Me.txtNewEmail, "") = "" Then
MsgBox "Please enter a new email address"
Resume Exit_Update
End If
DoCmd.OpenQuery "qryUpdateEmail"
Exit_Update:
Exit Sub
Exit_UpdateEmail:
If Err.Number = 2501 Then
Resume Exit_Update
Else
MsgBox Err.Description
Resume Exit_Update
End If
End Sub
rs.Close
Exit_Function:
Exit Function
End Function