Я все еще нахожусь в тупике над тем же проектом, над которым я работаю около недели. Я думаю, что я разработал VBA, но я когда-либо скромно использовал VBA в Access. Это моя первая попытка создать процедуру в Outlook 2010. В конечном счете, моя цель - проверить входящие электронные письма, чтобы увидеть, есть ли в них вложения. Если у них есть вложения, проверьте, является ли тип файла .xlsx. Если вложение представляет собой электронную таблицу, я хотел бы записать адрес электронной почты отправителей в таблицу с именем tblOutlookLog в базе данных Access с именем MSOutlook.ACCDB . Всякий раз, когда у вас есть шанс, вы можете просмотреть этот код и сообщить мне, что я делаю неправильно, или есть более эффективный способ выполнить то, что я пытаюсь достичь? Всякий раз, когда Outlook открывается, я получаю сообщение об ошибке, выделяя строку Set db = OpenDatabase (strdbPath & 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