Question : How do I save incoming email attachments into a specific folder?

Hi,

I would like to save incoming excel file attached in an email into subfolder. Based on the excel file name, I want to the excel file into a specific folder automatically. For example, an excel file named WFT_NC0136065_T01_James_201005.xls. I want the macro to pick up the unique keyword "NC0136065" from the spreadsheet name and put the excel file in the subfolder named "0136065 James".

I would like to modify the macro below that works with a rule.

Thank You
Amreska

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:



Sub SaveAttachmentsToDiskRule(Item As Outlook.MailItem)
    'Change the path on the next line to the folder you want the attachments save to.  The path must end with a backslash.'
    Const SAVE_TO_PATH = "C:\Some Folder\August 2009\"
    Dim olkAttachment As Outlook.Attachment, _
        strFilename As String, _
        objFSO As Object
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    For Each olkAttachment In Item.Attachments
        If objFSO.GetExtensionName(LCase(olkAttachment.FILENAME)) = "xls" Then
            If InStr(1, olkAttachment.FILENAME, "200908") Then
                strFilename = olkAttachment.FILENAME
                intcount = 0
                Do While True
                    If Dir(SAVE_TO_PATH & strFilename) = "" Then
                        Exit Do
                    Else
                        intcount = intcount + 1
                        'Edit the file name format on the next line as desired'
                        strFilename = "Copy (" & intcount & ") of " & olkAttachment.FILENAME
                    End If
                Loop
                olkAttachment.SaveAsFile SAVE_TO_PATH & strFilename
            End If
        End If
    Next
    Set objFSO = Nothing
    Set olkAttachment = Nothing
End Sub

 
Function md(dosPath As String, Optional createFolders As Boolean) As String
Dim fso As Object
Dim fldrs() As String
Dim rootdir As String
Dim fldrIndex As Integer
Dim bolret As Boolean
    
    md = ""
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(dosPath) Then
        fldrs = Split(dosPath, "\")
        rootdir = fldrs(0)
        If Not fso.FolderExists(rootdir) Then
            Exit Function
        End If
 
        bolret = True
        For fldrIndex = 1 To UBound(fldrs) - 1
            rootdir = rootdir & "\" & fldrs(fldrIndex)
            If Not fso.FolderExists(rootdir) Then
                If createFolders Then
                    fso.CreateFolder rootdir
                Else
                    bolret = False
                End If
            End If
        Next
        If bolret Then
            For Each fldr In fso.getfolder(rootdir).SubFolders
                If Left(fldr.Name, 2) = fldrs(UBound(fldrs)) Then
                    md = fldr.Path
                    Exit Function
                End If
            Next
        End If
        Exit Function
    End If
End Function

Answer : How do I save incoming email attachments into a specific folder?

>>after the insert the corresponding column in sql server 2008 has a value of 1884-07-21 !!! what mistake do i make?<<
But to answer your question .... :)

You have failed to add quotes around the date which is causing the following to happen:
1884-07-21 = -1990 ==> 1894-07-21 00:00:00.000

Your insert needs to look like this:
INSERT INTO xxx (aa,bb, Sent, Processed, cc,dd, linecount) VALUES ('aal','bb','20100626',0,'A12977F0F1D340929172EB61DD80A653@aatjanPC3', 4,'0')