我仍然对我已经工作了大约一周的同一个项目感到困惑。我想我已经解决了 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