I have tried another 10 ideas since my post this morning. I get sent a file every day with an attachment and what I need to do is is save that attachment to a folder. I only want the email from today saved in the folder. The code I have does not give me any errors but It isn't looping through the files either. When I step through I get a message of the oldest file in the folder. The message doesn't change it keeps on reading the same file, the code does not update. I only want the file to be saved if it was the file sent today.
Tom
Tom
Code:
'10th try
Dim objOutlook As Object
Dim objNamespace As Namespace
Dim objInbox As Object
Dim strFolderName As String
Dim objMailbox As Object
Dim objFolder As Object
Dim objItem As Object
Dim File_Path As String
Dim itm As MailItem
Dim atch As Object
Dim FileName As String
Dim strDate1 As String
Dim strDate2 As String
Dim strDate3 As String
Dim strDateType1 As String
Dim strDateType2 As String
Dim strDateType3 As String
Dim strFileName As String
Const olFolderInbox = 6
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("DailyNetAddsLegacy")
File_Path = "\\cable\ncd-shared\DIV-FIN-Business-Analytics-Shared\Adhoc\Tom\DOR\Daily_Net_Adds_Legacy\"
strDateType1 = "C_MM/DD/YYYY"
strDateType2 = "C_MMDDYYYY"
strDateType3 = ""
Call DefineDateType(strDate1, strDate2, strDate3, strDateType1, strDateType2, strDateType3)
' '''''Loop Thru Each Mail Item
For Each itm In objFolder.Items
'''''Loop Thru Each Attachment
For Each atch In itm.Attachments
On Error Resume Next
Set itm = atch
For Each myMail In Outlook.ActiveExplorer.Selection
MsgBox "Message was received at: " & myMail.ReceivedTime
If itm.ReceivedTime = strDate1 Then atch.SaveAsFile File_Path & atch.FileName
Next myMail
Next atch
Next itm