Saving attachments using date received

lionelnz

Well-known Member
Joined
Apr 6, 2006
Messages
568
Hi all.

I am trying to save attachments using the date sent/recieved in the format as YYMMDD as the attachment is saved as Inv#.

The problem I have is that the code is throwing up something weird. for a start it shows the same "YYMMDD" (991229) for all the msgs with attach's. Secondly there is no message sent on 29/12/99 (or 2009) in the business folder.

When I use the debugger with locals watch window the sDate variable comes up with 29/12/1899 ( therefore aDate = 991229) & stays that way thru the loop.
Code:
: sDate : #29/12/1899# : Date
(This is pasted from the watch window.)

Should I use something like "i = 1 to count msgs with attachments" (abbreviated of course) to loop thru the msg & therefore getting date sent for ech msg? (This of course does not account for the date error of 1899?????):confused:
My system is formatted as dd/mm/yyyy with each of my programs formatted independently according to my needs.

Rich (BB code):
Sub SaveOrconAtts()
'30/1/10 Updated with date option in attach Fname - wip
'29/1/10
'http://www.your-save-time-and-improve-quality-technologies-online-resource.com/
'save-attachments-from-outlook-using.html
   Dim ns As NameSpace
   Dim fld2SaveAtt As MAPIFolder
   Dim MailItem As Object
   Dim Att As Attachment
   Dim APath As String, FileName As String
   Dim sn As String
   Dim sDate As Date 'Email sent
   Dim aDate As String 'Attachment save date
   
   Dim intFiles As Integer
 
   On Error GoTo HandleError
   APath = "C:\Attachments\"
   Set ns = GetNamespace("MAPI")
   Set fld2SaveAtt = ns.GetDefaultFolder(olFolderInbox).Folders("Business")
   intFiles = 0
   
   
   If fld2SaveAtt.Items.Count = 0 Then
       MsgBox "There were no messages found in your Inbox."
       Exit Sub 'there are no messages, so Exit the Sub
   End If
   'Loop through Mail Items
   For Each MailItem In fld2SaveAtt.Items
        sn = MailItem.SenderName
         
       'Loop through any attachments
       For Each Att In MailItem.Attachments
        If sn = "accounts.receivable@abc.co.nz" Then
            sDate = MailItem.Sent
            aDate = Format(sDate, "yymmdd")
            FileName = Trim(Att.FileName)
            FileName = aDate & Att.FileName
            Att.SaveAsFile APath & FileName
            intFiles = intFiles + 1
            Else
        End If
       Next
   Next
' Show summary message
   If intFiles > 0 Then
       MsgBox intFiles & " attachments were saved to " ^ _
       "C:\Attachments."
   Else
       MsgBox "No attachments were found"
   End If
 
   Set Att = Nothing
   Set MailItem = Nothing
   Set ns = Nothing
   Exit Sub
HandleError:
   MsgBox "Error: " & Err.Number & vbCrLf & _
           "Description: " & Err.Description & vbCrLf & _
           "The file's name is " & FileName
           intFiles = intFiles - 1
   Resume Next 'Continue saving attachments
End Sub
 

Some videos you may like

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.

lionelnz

Well-known Member
Joined
Apr 6, 2006
Messages
568
I have resolved it. Using the Obj Browser Lib under Outlook, MailItem I found the the correct term was "SentOn" (NOT "Sent")so my line looks like this now

sDate = MailItem.SentOn And it works :biggrin:

Rich (BB code):
Sub SaveOrconAtts()
'30/1/10 Updated with date option in attach Fname - wip
'29/1/10
'http://www.your-save-time-and-improve-quality-technologies-online-resource.com/
'save-attachments-from-outlook-using.html
   Dim ns As NameSpace
   Dim fld2SaveAtt As MAPIFolder
   Dim MailItem As Object
   Dim Att As Attachment
   Dim APath As String, FileName As String
   Dim sn As String
   Dim sDate As Date 'Email sent
   Dim aDate As String 'Attachment save date
 
   Dim intFiles As Integer
 
   On Error GoTo HandleError
   APath = "C:\Attachments\"
   Set ns = GetNamespace("MAPI")
   Set fld2SaveAtt = ns.GetDefaultFolder(olFolderInbox).Folders("Business")
   intFiles = 0
 
 
   If fld2SaveAtt.Items.Count = 0 Then
       MsgBox "There were no messages found in your Inbox."
       Exit Sub 'there are no messages, so Exit the Sub
   End If
   'Loop through Mail Items
   For Each MailItem In fld2SaveAtt.Items
        sn = MailItem.SenderName
 
       'Loop through any attachments
       For Each Att In MailItem.Attachments
        If sn = "accounts.receivable@abc.co.nz" Then
            sDate = MailItem.SentOn
            aDate = Format(sDate, "yymmdd")
            FileName = Trim(Att.FileName)
            FileName = aDate & Att.FileName
            Att.SaveAsFile APath & FileName
            intFiles = intFiles + 1
            Else
        End If
       Next
   Next
' Show summary message
   If intFiles > 0 Then
       MsgBox intFiles & " attachments were saved to " ^ _
       "C:\Attachments."
   Else
       MsgBox "No attachments were found"
   End If
 
   Set Att = Nothing
   Set MailItem = Nothing
   Set ns = Nothing
   Exit Sub
HandleError:
   MsgBox "Error: " & Err.Number & vbCrLf & _
           "Description: " & Err.Description & vbCrLf & _
           "The file's name is " & FileName
           intFiles = intFiles - 1
   Resume Next 'Continue saving attachments
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,122,709
Messages
5,597,690
Members
414,164
Latest member
ARTW

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top