Hello,
I would appreciate your help with the folowing code, wich retrieves jpg files sent to a folder in my Outlook email account, and it works just fine, but if instead of receving a email with a image attachment, I just drag and drop a jpg file into the Outlook folder the code wont recognize that attachment. Anyway I can do that ?
Thanks for your help.
I would appreciate your help with the folowing code, wich retrieves jpg files sent to a folder in my Outlook email account, and it works just fine, but if instead of receving a email with a image attachment, I just drag and drop a jpg file into the Outlook folder the code wont recognize that attachment. Anyway I can do that ?
Thanks for your help.
Code:
Dim db As DAO.Database
Dim ns As Namespace
Dim Inbox As MAPIFolder
Dim FileName As String
Dim i As Integer, N As Integer, R 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")
'Debug.Print objSearchFolder.Items.Count
i = 0
If objSearchFolder.Items.Count = 0 Then
MsgBox "Nao existem emails Novos", vbInformation, "Sem Dados"
Exit Sub
End If
N = 1
For Each item In objSearchFolder.Items
For Each atmt In item.Attachments
Debug.Print N & " de " & item.Attachments.Count
FileName = "C:\eu\docs\docsArq\Pag " & N & "_" & atmt.FileName
atmt.SaveAsFile FileName
strSQL = "INSERT INTO tblDocs(docPath)" & _
"VALUES ('" & FileName & "')"
DoCmd.RunSQL strSQL
If Len(FileName) > 0 Then N = N + 1
i = i + 1
Next atmt
item.Delete
Next item
set objSearchFolder = Nothing
Set Inbox = Nothing
Set ns = Nothing
If i > 0 Then
MsgBox (N - 1 & " Documents added")
Else
MsgBox ("No Documents")
End If