Download email attachments from Outlook (1 Viewer)

cpampas

Registered User.
Local time
Today, 08:37
Joined
Jul 23, 2012
Messages
181
I am trying to download the attachments that I have in a folder in Outlook with the code :

Code:
Dim db As dao.Database
Dim ns As Namespace
Dim Inbox As MAPIFolder
Dim filename As String
Dim i As Integer
Dim objSearchFolder As Outlook.MAPIFolder
Dim item As MailItem
Dim atmt


Dim strSQL As String
Dim rst As dao.Recordset

Set db = CurrentDb()
Set ns = GetNamespace("MAPI")
Set rst = db.OpenRecordset("tblDocs", dbOpenDynaset)

Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set objSearchFolder = Inbox.Folders("docs")
i = 0

If objSearchFolder.Items.Count = 0 Then
    MsgBox "Search Folder is Empty", vbInformation, "Nothing Found"
End If


For Each item In objSearchFolder.Items
        For Each atmt In item.Attachments
            
                filename = "C:\eu\docs\docsArq\" & atmt.filename
                item.SaveAsFile filename
               strSQL = "INSERT INTO tblDocs(docPath)" & _
                    "VALUES ('" & filename & "')"
               DoCmd.RunSQL strSQL
              ' item.Delete
              atmt.SaveAsFile filename
            i = i + 1
        Next atmt
    Next item
          
Set objSearchFolder = Nothing
Set Inbox = Nothing
Set ns = Nothing
MsgBox ("Done !!")

If I declare dim atmt as attachment, the code does not even enter the loop that starts with For Each atmt In item.Attachments
I do have the amongst other the references

Microsoft Outlook 15.0 object library
Microsoft Office 16.0 Object library

the variable objSearchFolder.Items.Count returs the correct amount of emails in the folder. Any thoughts on why the varia atmt returns empty
Thanks a lot
 

cpampas

Registered User.
Local time
Today, 08:37
Joined
Jul 23, 2012
Messages
181
Arnel, i did as you suggersted and read those posts, wich made me find the solution, wich ended up as folows :

Code:
Dim db As dao.Database
Dim ns As Namespace
Dim Inbox As MAPIFolder
Dim filename As String
Dim i As Integer
Dim objSearchFolder As Outlook.MAPIFolder
Dim Item As MailItem
Dim atmt As Outlook.Attachment

Dim strSQL As String
Dim rst As dao.Recordset

Set db = CurrentDb()
Set ns = GetNamespace("MAPI")
Set rst = db.OpenRecordset("tblDocs", dbOpenDynaset)

Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set objSearchFolder = Inbox.Folders("docs")
i = 0

If objSearchFolder.Items.Count = 0 Then
    MsgBox "Search Folder is Empty", vbInformation, "Nothing Found"
End If


For Each Item In objSearchFolder.Items
        For Each atmt In Item.Attachments
                filename = "C:\eu\docs\docsArq\" & atmt.filename
                atmt.SaveAsFile filename
               strSQL = "INSERT INTO tblDocs(docPath)" & _
                    "VALUES ('" & filename & "')"
               DoCmd.RunSQL strSQL
             Item.Delete
              
            i = i + 1
        Next atmt
    Next Item
          
Set objSearchFolder = Nothing
Set Inbox = Nothing
Set ns = Nothing
MsgBox ("Done !!")
End Sub

Thank you
 

jaikaoliver

Member
Local time
Today, 08:37
Joined
Nov 18, 2019
Messages
35
C
Arnel, i did as you suggersted and read those posts, wich made me find the solution, wich ended up as folows :

Code:
Dim db As dao.Database
Dim ns As Namespace
Dim Inbox As MAPIFolder
Dim filename As String
Dim i As Integer
Dim objSearchFolder As Outlook.MAPIFolder
Dim Item As MailItem
Dim atmt As Outlook.Attachment

Dim strSQL As String
Dim rst As dao.Recordset

Set db = CurrentDb()
Set ns = GetNamespace("MAPI")
Set rst = db.OpenRecordset("tblDocs", dbOpenDynaset)

Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set objSearchFolder = Inbox.Folders("docs")
i = 0

If objSearchFolder.Items.Count = 0 Then
    MsgBox "Search Folder is Empty", vbInformation, "Nothing Found"
End If


For Each Item In objSearchFolder.Items
        For Each atmt In Item.Attachments
                filename = "C:\eu\docs\docsArq\" & atmt.filename
                atmt.SaveAsFile filename
               strSQL = "INSERT INTO tblDocs(docPath)" & _
                    "VALUES ('" & filename & "')"
               DoCmd.RunSQL strSQL
             Item.Delete
             
            i = i + 1
        Next atmt
    Next Item
         
Set objSearchFolder = Nothing
Set Inbox = Nothing
Set ns = Nothing
MsgBox ("Done !!")
End Sub

Thank you
Happy for you!
Can this Apply to Gmail account .....what modifications can be done kinldy
 

Users who are viewing this thread

Top Bottom