检查Outlook 2010 VBA代码

我仍然被这个我已经工作了一周的项目难住了。我想我已经解决了VBA的问题，但我只在Access中适度地使用过VBA。这是我第一次尝试在Outlook 2010中创建过程。最终，我的目标是检查收到的电子邮件，看看它们是否有附件。如果它们确实有附件，请检查文件类型是否为.xlsx。如果附件是电子表格，我想将发件人的电子邮件地址写入名为MSOutlook.ACCDB的Access数据库中名为tblOutlookLog的表中。每当你有机会的时候，你能不能检查一下这些代码，让我知道我做错了什么，或者是否有一个更有效的方法来适应我试图完成的任务？每当Outlook打开时，我都会收到一个错误，突出显示行Set db=OpenDatabasestrdbPath&strdbName，错误显示无法识别的数据库格式。我在此感谢您的帮助。再次感谢你

  Option Explicit

Private WithEvents InboxItems As Outlook.Items
    Dim olns As Outlook.NameSpace
    Dim olInbox As Outlook.MAPIFolder
    Dim olItem As Object
    Dim olAtmt As Outlook.Attachment
    Dim db As Database
    Dim rst As 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)
    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 rec As Recipient
    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
                If Item.Class = olMail Then
                    Set olItem = Item
                    With olItem
                            rst.AddNew
                            rst!Subject = Left(olItem.Subject, 255)
                            rst!Sender = olItem.Sender
                            rst!FromAddress = olItem.SenderEmailAddress
                            rst!Status = "Inbox"
                            rst!Logged = olItem.ReceivedTime
                            rst!AttachmentPath = strFilename
                            For Each rec In olItem.Recipients
                                rst!To = rst!To & rec.Name & " : " & rec.Address & ";"
                            Next
                            rst.Update
                    End With
                End If
            End If
        End If

         Next olAtmt
         Next olItem

        Set olAtmt = Nothing
        Set olItem = Nothing
    End Sub

---

嗨，我想你需要的是这些额外的线路

Dim作为DAO.Workspace工作

设置wks=工作空间0

然后换行

Set db=OpenDatabasestrdbPath&strdbName

到

Set db=wks.OpenDatabasestrdbPath&strdbName

这是基于我在一本叫做“DAO对象模型”的书中找到的东西，我确信这是我以前使用过的代码，但是我没有时间找到我在其中使用过的项目

---

也看看我在那里也查过了。Helen非常了解Access和DAO，她使用稍微不同的方法连接到远程Access数据库，但值得一看。

这似乎是的副本，您没有说明问题出在哪里。您能手动打开数据库吗？你试过dimdb作为DAO.database吗？您是否参考过Microsoft Data Access组件库？我将Dim db添加为DAO.database，但仍然收到相同的错误。如果同时添加对MS Access 14对象库和MS DAO 3.6对象库的引用，是否会出现任何类型的冲突？这应该是Microsoft Office 14.0 Access数据库引擎对象库，而不应该将MS DAO 3.6与accdb一起使用。您没有说是否可以手动打开数据库。让我们说不，您没有说，您只需要为.accdb、Microsoft Office 14.0 Access数据库引擎对象库选择正确的库在Access 2010中是否发生了更改？DAO库自2007年以来发生了更改，好的。