使用Access的应用程序定义或对象定义错误

时间:2013-04-17 14:16:57

标签: email vba outlook ms-office access-vba

我正在尝试通过Outlook发送自动电子邮件,但我遇到了一个问题,如果用户没有打开他们的电子邮件,我会得到Application-Defined or Object-Defined Error。我使用后期绑定来避免使用.dll,因为我在Office 2003和Office 2010上都有用户。

是否存在此错误仍然允许电子邮件通过?或者可能“迫使”展望未开放?

提前致谢

当然,这是电子邮件的完整代码。

当我单步执行时,Set appOutlookRec = .Recipients.Add(myR!Email)

失败
Option Explicit
Function SendEmail(strDep, strIssue, strPriority, strDate, strDesc, wonum, user)

Const olMailItem = 0
Const olTo = 1
Const olCC = 2
Dim sqlVar As String
Dim strSQL As String

If strDep = "Cycle" Then

ElseIf strDep = "Fabrication" Then
    sqlVar = "Fabricator"
ElseIf strDep = "Facility" Then
    sqlVar = "Facility"
ElseIf strDep = "Gage" Then
    sqlVar = "Gage"
ElseIf strDep = "IT" Then
    sqlVar = "IT"
ElseIf strDep = "Machine Shop" Then
    sqlVar = "Machine_Shop_Manager"
ElseIf strDep = "Safety" Then
    sqlVar = "Safety"
ElseIf strDep = "Maintenance" Then
    sqlVar = "Maintenance_Manager"
ElseIf strDep = "Supplies Request" Then
    sqlVar = "Supplies"
Else:
End If

Dim myR As Recordset

'Refers to Outlook's Application object
Dim appOutlook As Object
'Refers to an Outlook email message
Dim appOutlookMsg As Object
'Refers to an Outlook email recipient
Dim appOutlookRec As Object

'Create an Outlook session in the background
Set appOutlook = CreateObject("Outlook.Application")

'Create a new empty email message
Set appOutlookMsg = appOutlook.CreateItem(olMailItem)

'Using the new, empty message...
With appOutlookMsg    

strSQL = "SELECT Email FROM Employees WHERE " & sqlVar & " = True"
Set myR = CurrentDb.OpenRecordset(strSQL)

Do While Not myR.EOF
Set appOutlookRec = .Recipients.Add(myR!Email)
appOutlookRec.Type = olTo
myR.MoveNext
Loop

strSQL = "SELECT Email FROM Employees WHERE '" & user & "' = Username"

Set myR = CurrentDb.OpenRecordset(strSQL)

Set appOutlookRec = .Recipients.Add(myR!Email)
appOutlookRec.Type = olCC

.Subject = wonum

.Body = "Department: " & strDep & vbNewLine & vbNewLine & _
    "Issue is at: " & strIssue & vbNewLine & vbNewLine & _
    "Priority is: " & strPriority & vbNewLine & vbNewLine & _
    "Complete by: " & strDate & vbNewLine & vbNewLine & _
    "Description: " & strDesc

.Send

End With

Set myR = Nothing
Set appOutlookMsg = Nothing
Set appOutlook = Nothing
Set appOutlookRec = Nothing

End Function

3 个答案:

答案 0 :(得分:0)

尝试之前使用.Save。发送。我通过MS Access安排了Outlook代码。

答案 1 :(得分:0)

所以看起来正在发生的事情是你对Outlook.Application的引用。停滞不前 - 缺乏更好的词汇。您不仅要创建Outlook会话 - 还要连接到现有的正在运行的应用程序。

我不是Access的专家,所以我只是建议一般性:尝试获取已经运行的Outlook应用程序的句柄,否则让它打开Outlook(给它时间来完全启动使用sleep / wait和a DoEvents命令)并再次尝试获取该句柄。

我在Outlook中使用VBA试图读取发件人名称(也得到相同的错误)。追溯到我获取当前Outlook应用程序句柄的方法。 而不是:

Set appOutlook = CreateObject("Outlook.Application");

我必须:

Set appOutlook = ThisOutlookSession;

希望这有帮助!

答案 2 :(得分:0)

Set appOutlook = CreateObject("Outlook.Application")行后,添加以下内容:

set NS = appOutlook.GetNamespace("MAPI")
NS.Logon