Outlook 2010 VBA无效或不合格的参考

时间:2012-02-27 22:34:34

标签: ms-access vba outlook-vba outlook-2010

我正在尝试采用不同的方法处理前几天正在处理的事情。在工作中,我们使用Outlook 2010并在一天内接收带有.XLSX附件的电子邮件。我试图弄清楚如何在Outlook中使用VBA来检查传入的电子邮件是否附件,然后如果附件计数是> 0,测试附件,如果是电子表格,请使用发件人地址簿信息更新 tblOutlookLog 。这只是我在MS Access之外尝试VBA的第二天或第三天,我在黑暗中摸索试图弄清楚语法。我在下面的Outlook中发布了以下代码。我在 .Subject 行的 olInbox_ItemAdd(ByVal Item As Object)部分中收到错误,指出它是“无效或不合格的参考”。我事先道歉,因为它很草率。感谢您的任何帮助或指导。

Option Explicit

Private WithEvents InboxItems As Outlook.Items
    Dim olns As NameSpace
    Dim olInbox As MAPIFolder
    Dim olItem As Object
    Dim olAtmt As Attachment
    Dim db As DAO.Database
    Dim rst As DAO.Recordset

    Const strdbPath = "\\FMI-FS\Users\sharp-c\Desktop\"
    Const strdbName = "MSOutlook.accdb"
    Const strTableName = "tblOutlookLog"

Private Sub Application_Startup()
    Set olns = GetNamespace("MAPI")
    Set olInbox = olns.GetDefaultFolder(olFolderInbox).Items
    Set db = OpenDatabase(strdbPath & strdbName)
    Set rst = db.OpenRecordset(strTableName, dbOpenDynaset)
End Sub

Private Sub Application_Quit()
    On Error Resume Next
    rst.Close
    db.Close
    Set olns = Nothing
End Sub


Private Sub olInbox_ItemAdd(ByVal Item As Object)
    Dim olItem As Outlook.MailItem
    Dim olAtmt As Outlook.Attachment
    Dim strFoldername As String
    Dim strFilename As String
    Dim i As Integer
    i = 0

    For Each olItem In olInbox.Items
      For Each olAtmt In olItem.Attachments
        If olItem.olAtmt.Count > 0 Then
            If Right$(olAtmt.FileName, 5) = ".xlsx" Then
                strFilename = "\\FMI-FS\Users\sharp-c\Desktop\Test" & olAtmt.FileName
                olAtmt.SaveAsFile strFilename
                i = i + 1
                    rst.AddNew
                    rst!Subject = Left(.Subject, 255)
                    rst!Sender = .Sender
                    rst!FromAddress = .SenderEmailAddress
                    rst!Status = "Inbox"
                    rst!Logged = .ReceivedTime
                    rst!AttachmentPath = strFilename
                    Next
                    rst.Update
            End If

         Next olAtmt
         Next olItem

        Set olAtmt = Nothing
        Set olItem = Nothing
End Sub

1 个答案:

答案 0 :(得分:3)

您需要在项目前加上对象:

rst!Subject = Left(olItem.Subject, 255)

等等。我想你可能已经在某个阶段删除了。