检查 Outlook 2010 VBA 代码

Question

我仍然对我已经工作了大约一周的同一个项目感到困惑。我想我已经解决了 VBA，但我只在 Access 中适度使用过 VBA。这是我第一次尝试在 Outlook 2010 中创建程序。最终，我的目标是检查传入的电子邮件以查看它们是否有附件。如果他们确实有附件，请检查文件类型是否为 .xlsx。如果附件是电子表格，我想将发件人电子邮件地址写入名为 MSOutlook.ACCDB 的 Access DB 中名为 tblOutlookLog 的表中。每当您有机会时，请您查看此代码并让我知道我做错了什么，或者是否有更有效的方法来适应我要完成的工作？每当 Outlook 打开时，我都会收到一条错误消息，突出显示 Set db = OpenDatabase(strdbPath & strdbName) 行，并且错误提示 Unrecognized Database format。提前感谢您的帮助。再次感谢您！

  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

Answer 1

您好，我认为您需要的是这些额外的行

将 wks 作为 DAO.Workspace

设置 wks = Workspaces(0)

然后更改以下行

设置 db = OpenDatabase(strdbPath & strdbName)

到

设置 db = wks.OpenDatabase(strdbPath & strdbName)

这是基于我找到的一本我称之为“DAO 对象模型”的书我确定这是我以前使用过的代码但是我没有时间找到我使用它们的项目。

还可以查看http://www.helenfeddema.com/CodeSamples.htm 我也在那里检查过。 Helen 非常了解 Access 和 DAO，她使用稍微不同的方法连接到远程访问数据库，但值得一看。