Question

我正在使用Access VBA代码在设定的时间后自动通过Outlook发送电子邮件。

我一直收到运行时错误3085。我不知道出了什么问题或它所指的是什么功能。可能是我丢失的参考，还是我搞砸了某个地方的功能？

Option Compare Database
Sub SendMail()
Dim db As DAO.Database
Dim rs As DAO.Recordset

Dim emailTo As String
Dim emailSubject As String
Dim emailText As String

Dim outApp As Outlook.Application
Dim outMail As Outlook.MailItem
Dim outlookStarted As Boolean

On Error Resume Next
Set outApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If outApp Is Nothing Then
Set outApp = CreateObject("Outlook.Application")
outlookStarted = True
End If

Set db = CurrentDb
strSQL = "SELECT DATE, COMPANY, CUSTOMER, EMAIL(DISTRIBUTOR), FUP" & _
  " FROM Sample Query WHERE DATE = (Date())"
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)

Do Until rs.EOF

  emailTo = Trim(rs.Fields("COMPANY").Value & " " & _
    rs.Fields("CUSTOMER").Value) & _
    " <" & rs.Fields("EMAIL(DISTRIBUTOR)").Value & ">"

  emailSubject = "Proposal Follow Up"
  If IsNull(rs.Fields("COMPANY").Value) Then
      emailSubject = emailSubject & " for " & _
        rs.Fields("COMPANY").Value & " " & rs.Fields("CUSTOMER").Value
  End If

  emailText = Trim("Hello " & rs.Fields("COMPANY").Value) & "!" & vbCrLf

  emailText = emailText & _
    "We put an order on " & rs.Fields("DATE").Value & _
    " for " & rs.Fields("COMPANY").Value & _
    "A follow up would be good about now"

  Set outMail = outApp.CreateItem(olMailItem)
  outMail.To = emailTo
  outMail.Subject = emailSubject
  outMail.Body = emailText
  outMail.Send

  rs.Edit
  rs("FUP") = Now()
  rs.Update

  rs.MoveNext
Loop

rs.Close
Set rs = Nothing
Set db = Nothing

If outlookStarted Then
    outApp.Quit
End If

Set outMail = Nothing
Set outApp = Nothing
End Sub

Answer 1

EMAIL(DISTRIBUTOR)必须用方括号括起来才能有效。

strSQL = "SELECT DATE, COMPANY, CUSTOMER, [EMAIL(DISTRIBUTOR)]

“表达式中的运行时错误'3085'未定义函数'EMAIL'”

1 个答案: