Storing Outlook Attachments and Patch in table (1 Viewer)

jayhawker

New member
Local time
Today, 07:25
Joined
May 25, 2015
Messages
6
Hi all! Currently, I'm taking my unread emails, storing them in a table then sending any Excel files to a specified folder I've modified some code I found while surfing and it works great but I'd really like to send the attachment name and file path with the email recordset. It's been a long day so maybe it's super simple. Below is my code and I'd appreciate any help you could provide. Thank you!! Office 2010 Windows 8.1

PHP:
Function ReadInbox()
Dim TempRst As DAO.Recordset
Dim OlApp As Outlook.Application
Dim Inbox As Outlook.MAPIFolder
Dim Atmt As Outlook.Attachment
Dim InboxItems As Outlook.Items
Dim Mailobject As Object
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim dealer As Integer
Dim struser As String
Dim strlocation As String


On Error GoTo ErrHandler
DoCmd.SetWarnings False
DoCmd.SetWarnings True
Set db = CurrentDb
Set rst = db.OpenRecordset("SELECT [FILELOCATION] FROM tblattachmentlocation WHERE([AUTOID]=1);")
strlocation = rst(0).Value
rst.Close
Set rst = Nothing
Set OlApp = CreateObject("Outlook.Application")
Set Inbox = OlApp.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox)
Set TempRst = CurrentDb.OpenRecordset("tbl_OutlookTemp")
'
Set InboxItems = Inbox.Items

For Each Mailobject In Inbox.Items
    If Mailobject.UnRead Then
        For Each Atmt In Mailobject.Attachments
            If Right(Atmt.FileName, 4) = "xlsx" Then FileName = strlocation & "\" & Atmt.FileName: Atmt.SaveAsFile FileName
        Next Atmt
        With TempRst
            .AddNew
            !Subject = Nz(Mailobject.Subject)
            !From = Nz(Mailobject.SenderName)
            !To = Nz(Mailobject.To)
            !Body = Nz(Mailobject.Body)
            !DateSent = Nz(Mailobject.SentOn)
            .Update
            
            Mailobject.UnRead = False
        End With
    End If
Next Mailobject
On Error GoTo 0
Set OlApp = Nothing
Set Inbox = Nothing
Set InboxItems = Nothing
Set Mailobject = Nothing
Set TempRst = Nothing
Set db = Nothing
Exit Function
ErrHandler:
MsgBox "Your received error number: " & Err.Number & " please contact xxxxxxxx.", vbCritical + vbOKOnly, "Email Retrieval Error"
Err.Clear
On Error GoTo 0
Set OlApp = Nothing
Set Inbox = Nothing
Set InboxItems = Nothing
Set Mailobject = Nothing
Set TempRst = Nothing
Set db = Nothing

End Function
 

vbaInet

AWF VIP
Local time
Today, 14:25
Joined
Jan 22, 2010
Messages
26,374
... I'd really like to send the attachment name and file path with the email recordset.

Code:
Function ReadInbox()
            If Right(Atmt.FileName, 4) = "xlsx" Then [COLOR="blue"]FileName [/COLOR]= strlocation & "\" & Atmt.FileName: Atmt.SaveAsFile [COLOR="blue"]FileName[/COLOR]
You've got the relevant elements and you're already working with a Outlook objects, so you can create a mail item and send whatever is in the recordset. Research Outlook VBA mail item.
 

Users who are viewing this thread

Top Bottom