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

Hi,

I have a macro below that saves 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. The macro below works only for an excel file named WFT_NC0136065_T01_James_201005.xls. I want to modify the macro so that it works for both excel file names: WFT_NC0136065_T01_James_201005.xls or WFT_NC0136065_T01_James_201005-01.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".

Thank You

         
           
             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:

           
           
          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, _
        strSubfolder As String, _
        strFilename As String, _
        objFSO As Object, _
        arrParts As Variant
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    For Each olkAttachment In Item.Attachments
        If objFSO.GetExtensionName(LCase(olkAttachment.FileName)) = "xls" Then
            arrParts = Split(olkAttachment.FileName, "_")
            If UBound(arrParts) = 4 Then
                'Add other cases as needed'
                Select Case arrParts(1)
                    Case "NC0136065"
                        strSubfolder = SAVE_TO_PATH & "0136065 James\"
                    Case "NC0564454"
                        strSubfolder = SAVE_TO_PATH & "0564454 Man\"
                    Case Else
                        strSubfolder = ""
                End Select
                strFilename = olkAttachment.FileName
                intCount = 0
                Do While True
                    If Dir(strSubfolder & 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 strSubfolder & strFilename
            End If
        End If
    Next
    Set objFSO = Nothing
    Set olkAttachment = Nothing
End Sub

           
         

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

Save something like this as whatever.cmd:

                       
             start "" explorer.exe "C:\Folder1"
start "" explorer.exe "C:\Folder2"
start "" explorer.exe "C:\Folder3"

If you want the Explorer windows to show up with the tree structure in the left pane,

start "" explorer.exe /e,"C:\Folder1"
start "" explorer.exe /e,"C:\Folder2"
start "" explorer.exe /e,"C:\Folder3"