Saving attachments using date received

[lionelnz]

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.

: 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?????)
My system is formatted as dd/mm/yyyy with each of my programs formatted independently according to my needs.

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

 

[lionelnz]

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

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