- Joined
- Jan 30, 2019
- Messages
- 2
- Reaction score
- 0
Private Sub get_email_attchment()
Dim objOutlook, objNamespace, objFolder, colItems, objMessage, intCount, i, colFilteredItems
Dim fso, file, fld
Dim objFile, strobjfile,
Dim objInbox, strFolderName, objMailbox
Dim oMessage As Object
Dim Mydate As Date
Dim subjects, Start As String
Call TogetDate
strFolder = "C:\Desktop"
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(strFolder)
'Move attachments in Inbox from Outlook to folder
strFolderf = "C:\"
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objInbox = objNamespace.GetDefaultFolder(olFolderInbox)
strFolderName = objInbox.Parent
Set objMailbox = objNamespace.Folders(strFolderName)
Set objFolder = objMailbox.Folders("DAILY FILES")
On Error Resume Next
Set colItems = objFolder.Files
For Each objMessage In colItems
x = x + 1
intCount = objMessage.Attachments.Count
If intCount > 0 Then
For i = 1 To intCount
'Checks if file exists in temp folder, changes file name
strobjfile = objMessage.Attachments.Item(i).Filename
FileLastModified = fso.objMessage.Attachments.Item(i).Filename.DateLastModified
If FileDateTime(strobjfile) = Mydate Then
objMessage.Attachments.Item(i).SaveAsFile strFolder & objMessage.Attachments.Item(i).Filename
End If
Next
End If
Next
Dim objOutlook, objNamespace, objFolder, colItems, objMessage, intCount, i, colFilteredItems
Dim fso, file, fld
Dim objFile, strobjfile,
Dim objInbox, strFolderName, objMailbox
Dim oMessage As Object
Dim Mydate As Date
Dim subjects, Start As String
Call TogetDate
strFolder = "C:\Desktop"
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(strFolder)
'Move attachments in Inbox from Outlook to folder
strFolderf = "C:\"
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objInbox = objNamespace.GetDefaultFolder(olFolderInbox)
strFolderName = objInbox.Parent
Set objMailbox = objNamespace.Folders(strFolderName)
Set objFolder = objMailbox.Folders("DAILY FILES")
On Error Resume Next
Set colItems = objFolder.Files
For Each objMessage In colItems
x = x + 1
intCount = objMessage.Attachments.Count
If intCount > 0 Then
For i = 1 To intCount
'Checks if file exists in temp folder, changes file name
strobjfile = objMessage.Attachments.Item(i).Filename
FileLastModified = fso.objMessage.Attachments.Item(i).Filename.DateLastModified
If FileDateTime(strobjfile) = Mydate Then
objMessage.Attachments.Item(i).SaveAsFile strFolder & objMessage.Attachments.Item(i).Filename
End If
Next
End If
Next