我正在尝试一种不同的方法来处理我前几天正在做的事情。在工作中,我们使用 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