Saving Emails to Server Locations Macro on Receipt

[jamieh1]

First of all, this forum pops up on nearly every search I've done so far. A massive thank you to all that this website and its users provides in helping out the world.

Second, I've searched for this specific macro found some pretty on point results, but I can't seem to change the right things to make it work.

I'm looking for a way to automate the saving of correspondence to variable locations on my work server. I want to be selective on the emails I save, and I would also like my coworkers to be able to do the same, so my thinking was I could set-up a dummy-email which I could use to set up rules that would search for our project numbers. I would then forward the emails I wanted saved to this email and type the project number into the body of the email. The rule would then run the macro, identify the project number, and save to appropriate correspondence subfolder.

However, since this email would only receive emails I would want it to save, the Rule step might not be necessary with a better understanding of Vba. If the Rule step could be eliminated, this would greatly reduce time I would have to spend nurturing this system later.

The format project number format is either H\NNN-NNN or H\NNNN-NNNN which are parent locations containing all projects between 100-199, for example. Once inside either of these locations, project folders are then located at NNN-NNN "Name of Project" or NNNN-NNN "Name of Project". Finally, a Correspondence folder is located which would be the target.

All in all, as an example the target location would look like H\NNN-NNN\NNN-NNN Name of Project\Correspondence or H\NNNN-NNNN\NNNN-NNN Name of Project\Correspondence.
Editing for more clarification here. The final format of a given project would look like H:\200-299\296-001 Second Street Project\Correspondence

Again, a massive thank you to anyone who takes the time to help me figure this out.

[gmayor]

You would still need a rule to run the macro script. You could run it on all incoming mail. That isn't the problem here. The problem is that of identifying which folder to save the message to. You spent much time explaining the location where the message would be saved, but, as far as I can see, none explaining the layout of the message and what exactly the macro would be looking for in that message to establish how to direct the message to the target location. Can you post a sample message?

[jamieh1]

The problem is that of identifying which folder to save the message to. You spent much time explaining the location where the message would be saved, but, as far as I can see, none explaining the layout of the message and what exactly the macro would be looking for in that message to establish how to direct the message to the target location. Can you post a sample message?

The closest example to what I'm intending the macro to do can be found here: (Can't post url. Search for thread titled "Save emails to a Directory based on code in subject"

There wouldn't be a lot of consistency to the messages that the macro would process in themselves. My goal is to have the macro target the project number which would have to be manually input on the subject (or body, whatever is easier) forwarded to the dummy account.

Example: [SUBJECT] 436-001 FW: Important Details. [BODY] (This area would change a great deal, and would often have attachments).

The dummy email would receive this email, a rule would run the macro, the macro would recognize the project number to determine the save path, and save at H\400-499\436-001 The Project\Correspondence by date/sender if possible.

[gmayor]

Using a message with your example subject, does the following get the path you want?


Sub Macro1()
Dim olItem As MailItem
Dim strPath As String
Dim strProject As String, strDate As String
Dim strSubject As String, strSender As String
On Error Resume Next

Select Case Outlook.Application.ActiveWindow.Class
Case olInspector
Set olItem = ActiveInspector.currentItem
Case olExplorer
Set olItem = Application.ActiveExplorer.Selection.Item(1)
End Select

With olItem
strSubject = .Subject
strDate = Format(.SentOn, "yyyymmdd")
strSender = .sender
End With

strPath = GetPath(strSubject)
If Not strPath = "" Then
strProject = Mid(strSubject, Len(strPath) + 1)
strProject = CleanFileName(strProject)
strPath = "H:\400-499\" & strPath & "\" & strProject & "Correspondence by " & strDate & "_" & strSender
End If
MsgBox strPath
lbl_Exit:
Set olItem = Nothing
Exit Sub
End Sub

Private Function GetPath(strSubject As String) As String
Dim vNum As Variant
vNum = Split(strSubject, Chr(32))
strSubject = Replace(vNum(0), "-", "")
If IsNumeric(strSubject) = True Then
strSubject = CStr(vNum(0))
GetPath = strSubject
End If
End Function

Private Function CleanFileName(strFileName As String) As String
Dim arrInvalid() As String
Dim lng_Index As Long
'Define illegal characters (by ASCII CharNum)
arrInvalid = Split("9|10|11|13|34|42|47|58|60|62|63|92|124", "|")
'Remove any illegal filename characters
CleanFileName = strFileName
For lng_Index = 0 To UBound(arrInvalid)
CleanFileName = Replace(CleanFileName, Chr(arrInvalid(lng_Index)), Chr(95))
Next lng_Index
lbl_Exit:
Exit Function
End Function

[jamieh1]

I had to Reg edit to be able to do "run a script" on a rule, and then it didn't recognize the script. It did not work, although note the changes I made below.

I changed


Sub Macro1()

to


Sub Macro1 (item as Outlook.MailItem)

and that made the script visible in the "run a script" option. Is it necessary to run the script via a rule, or can the script run itself on inbound messages? Expect a donation from me if we can get this working.

[gmayor]

The code I posted wasn't intended as a script. It is merely a test to see if it produces the path you want from your message format. The script can come later when we have established this part.
Change it back and run it on a message and see what the message box produces. If it doesn't work as intended, send a sample message as an attachment to my web site and include your forum username in the subject, or it will be discarded.