Outlook 2010 Script Rule. 3

[Jellybrain]

So i am in a bit of a pickle. i am new to programming all together. But here is my situation: Our company uses and IBM mainframe to process all the database queries. the mainframe doesnt interact well with the MS infrastructure we have today. They want it to folder the PDF reports it generates. the only way we have figure it how to dynamically do this is to send an email to a dummy client(email address) with a subject line that has the folder path and the attached PDF. the company currently used a macro that ran continuously in the background to folder these reports (PDF). if one had a bad subject line it would error out continuously until some happened to look at the PC off in a corner. so i suggested we use a rule script that only ran once per email. so if an email erred it only pop one message not 500+ if you didn't catch it. (the problem i have found with the rule scripts is that it can only be one "sub". Since i had the idea i got tasked with it. again this is my best effort at piece melding this together. Here is where I stand: I have the rule working when it comes to foldering the attachment based on the subject IF the path is there and no subject line error code. Added the if then for the error code on report "XX" added the create folder path part [highlight #FCE94F]but it will only create one folder.[/highlight] YOUR HELP IS GREATLY APPRECIATED.


Here is my Code:
-----------------------------------------------------------------------------------------------------
Public Sub SaveAttachments2(mail As Outlook.MailItem)
On Error GoTo GetAttachments_err

Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer
Dim f As String
Dim strSubject As String
Dim w As Integer
Set FSO = CreateObject("Scripting.FileSystemObject")

strSubject = mail.Subject
f = strSubject
'check for bad subject lines and delete them.
If InStr(1, f, "XX") Then
mail.Delete
Exit Sub
End If


' MkDir ("Z:\OPERATIO\AS400_Report\" & f)

StrFolderPath = "Z:\Chuck_Norris\IBM_Mainframe\" & f & "\"
If Not FSO.FolderExists(StrFolderPath) Then
FSO.CreateFolder (StrFolderPath)
End If


For Each Atmt In mail.Attachments
FileName = "Z:\Chuck_Norris\IBM_Mainframe\" & f & "\" & Atmt.FileName
'popup window to confirm its working for now. (currently commented out)
'MsgBox "Attachment and path " & Atmt.FileName, vbOKOnly, "What and Where"
Atmt.SaveAsFile FileName
i = i + 1

'to delete the item
Next Atmt
mail.Delete
GetAttachments_exit:
Set Atmt = Nothing

Exit Sub

GetAttachments_err:
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Please note and report the following information." _
& vbCrLf & "Macro Name: SaveAttachments2" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
Resume GetAttachments_exit

End Sub
-----------------------------------------------------------------------------------------------------------------

I have tried working with something like this:

http://www.tek-tips.com/viewthread.cfm?qid=1032777

------------------------------------------------------------------------------------------------------------------
strNewFolder = ""
Do Until strPath = strNewFolder
strNewFolder = Left(strPath, InStr(Len(strNewFolder) + 1, strPath, "\"))

If objFileSys.FolderExists(strNewFolder) = False Then
objFileSys.CreateFolder(strNewFolder)
End If
Loop
------------------------------------------------------------------------------------------------------------------

Tried adding another if not then like in the code, but i cant seem to get it to work right with only one sub. Also as far as i can tell you have to have "mail As Outlook.MailItem" for it to show up in the rule > when email has an attachment > run script > click script > a list appears (macros don't show up).

"Public Sub SaveAttachments2(mail As Outlook.MailItem)

 

[SkipVought]

hi,

This forum is VBA Visual Basic for [highlight #FCE94F]Applications[/highlight]: Like Excel, Word, PowerPoint etc.

I think that you want to post in forum329.

Skip,

_{Just traded in my OLD subtlety...
for a NUance!}

 

[Jellybrain]

sorry i will look into moving it. yeah i thought outlook fell under that: again im wet behind the ears when it came to this.

 

[strongm]

No, no, I think it belongs here. The OP is talking about an Outlook rule 'script' - and the 'scripting' language for that is VBA ...

 

[strongm]

>"mail As Outlook.MailItem" for it to show up in the rule

MeetingItem will work as well. And in Outlook 2010/13 Postitem is another alternative.

Now, I'm not sure I entirely understand your problem. Could you have another go at explaining it?

 

[SkipVought]

I stand corrected

Skip,

_{Just traded in my OLD subtlety...
for a NUance!}

 

[Jellybrain]

Everything works but one last thing i need, it to create multiple folder paths (if needed).

So there is a set path
"Z:\Chuck_Norris\IBM_Mainframe\"
in addition to that there is "f"
Dim f As String
f = strSubject
StrFolderPath = "Z:\Chuck_Norris\IBM_Mainframe\" & f & "\"

Example subject line 290\2014\Lucky_Charmsso to folder the attachment i need the path
Z:\Chuck_Norris\IBM_Mainframe\290\2014\Lucky_Charmsplacing Report.pdf there.

if everything up to 2014 is existing it creates Lucky_Charms and places PDF.
But if 2014 doesn't exist it errs out. (copy and paste error code below)


---------------------------
Error!
---------------------------
An unexpected error has occurred.

Please note and report the following information.

http://www.tek-tips.com/viewthread.cfm?qid=1727511

Macro Name: SaveAttachments2

Error Number: 76

Error Description: Path not found
---------------------------
OK
---------------------------


Hope this helps. i apologize for any incorrect term usage or bad code!

 

[strongm]

Ah, right. With you. In which case, PHV's code (myCreateFolder) in the thread that you linked should do the trick. Although it does potentially miss out one important bit of code (that might not be necessary, but I can't see your public declarations or whether you have Option Explicit set or not - although it looks like it isn't ... ). So his sub should read something like:

[blue][green]' Minor adaptation of PHV's code from thread329-1032777[/green]
Sub myCreateFolder(strPath)
    Dim fso
    Dim tmpArr
    Dim tmpPath
    Dim i
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    tmpArr = Split(strPath, "\")
    tmpPath = tmpArr(0)
    For i = 1 To UBound(tmpArr)
        If Not fso.FolderExists(tmpPath) Then
            fso.CreateFolder tmpPath
        End If
        tmpPath = tmpPath & "\" & tmpArr(i)
    Next
End Sub[/blue]

Then in your code replace

[blue]StrFolderPath = "Z:\Chuck_Norris\IBM_Mainframe\" & f & "\"
If Not FSO.FolderExists(StrFolderPath) Then
FSO.CreateFolder (StrFolderPath)
End If[/blue]

with

[blue]StrFolderPath = "Z:\Chuck_Norris\IBM_Mainframe\" & f & "\"
myCreateFolder StrFolderPath[/blue]

 

[Jellybrain]

I have everything in my vba script rule posted.

 

[Jellybrain]

i take it i am to add the first box and the replace like you suggested. then i get multiple subs I can not get multple subs to show up in the outlook rule option. is that possible?

 

[strongm]

You don't actually need to see the new sub from the rule's script list, though

And, as you have previously observed, any sub with a parameter defined as MailItem (or MeetingItem or PostItem) will appear in that list. And there is absolutely no reason why you cannot have multiple subs with such a parameter.

 

[Jellybrain]

okay this is what i have come up with [now its not saving attachments (even if the path exists), popping up errors, or creating any folder]

Public Sub SaveAttachments2(mail As Outlook.MailItem)

On Error GoTo GetAttachments_err:

Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer
Dim f As String
Dim strSubject As String
Dim w As Integer
Set fso = CreateObject("Scripting.FileSystemObject")

strSubject = mail.Subject
f = strSubject
'check for bad subject lines and delete them.
If InStr(1, f, "XX") Then
    mail.Delete
    Exit Sub
    End If
    

' MkDir ("Z:\OPERATIO\AS400_Report\" & f)

StrFolderPath = "Z:\OPERATIO\AS400_Report\" & f & "\"
myCreateFolder StrFolderPath

        
For Each Atmt In mail.Attachments
FileName = "Z:\OPERATIO\AS400_Report\" & f & "\" & Atmt.FileName
'popup window to confirm its working for now. (currently commented out)
MsgBox "Attachment and path " & Atmt.FileName, vbOKOnly, "What and Where"
Atmt.SaveAsFile FileName
i = i + 1

'to delete the item
Next Atmt
mail.Delete
GetAttachments_exit:
Set Atmt = Nothing

Exit Sub


GetAttachments_err:
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Please note and report the following information." _
& vbCrLf & "Macro Name: SaveAttachments2" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
Resume GetAttachments_exit:
End Sub

Sub myCreateFolder(strPath)
    Dim fso
    Dim tmpArr
    Dim tmpPath
    Dim x
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    tmpArr = Split(strPath, "\")
    tmpPath = tmpArr(0)
    For x = 1 To UBound(tmpArr)
        If Not fso.FolderExists(tmpPath) Then
            fso.CreateFolder tmpPath
        End If
        tmpPath = tmpPath & "\" & tmpArr(x)
    Next
End Sub

 

[Andrzejek]

Do you, by any chance, sending an e-mail with XX in a Subject line?

If InStr(1, f, "[red]XX[/red]") Then
    mail.Delete
    [red]Exit Sub[/red]
End If

When you step thru your code, do you go to the code where you are supposed to?

Have fun.

---- Andy

 

[Jellybrain]

no here is the subject line of the test email i am sending. "290\2015\Naptime"

When i try to step thru "f8" nothing happens :-(
(again i'm new to this because its not a macro but a script)
BUT i activated the msg box that i use to determine the file path it comes up blank.

For Each Atmt In mail.Attachments
FileName = "Z:\OPERATIO\AS400_Report\" & f & "\" & Atmt.FileName
'popup window to confirm its working for now. (currently commented out)
MsgBox "Attachment and path " & Atmt.FileName, vbOKOnly, "What and Where"
Atmt.SaveAsFile FileName
i = i + 1

Returns

---------------------------
What and Where
---------------------------
Attachment and path
Z:\OPERATIO\AS400_Report\290\2015\Naptime\201312_SUMMARY.PDF201312_SUMMARY.PDF
---------------------------
OK
---------------------------

 

[Andrzejek]

So your code works OK up to this point. You should have your folders: [tt]290\2015\Naptime[/tt] created (right?)

What you have after that is:

...
i = i + 1
[green]
'to delete the item[/green]
Next Atmt  [green]'Loop end here[/green]
mail.Delete   [green]'Delete mail[/green]
GetAttachments_exit:
Set Atmt = Nothing

Exit Sub   [green]'And we are out and DONE[/green]

There is NO more code to execute. :-(

Have fun.

---- Andy

 

[Jellybrain]

nope its not creating the folders

 

[Andrzejek]

When i try to step thru "f8" nothing happens "

So you are in VBA in Outlook and breakpoints do not work?

Setting them up in your code would help you A LOT.

Have fun.

---- Andy

 

[Jellybrain]

Alright lets take a different approach. i decided to take out the check\create folder part and put it in its own script. Here is my new issue.

Public Sub CreateFolders(Mail As Outlook.MailItem)

   Dim f As String
   Dim strSubject As String
   Dim objFileSys
   Dim strPath, strNewFolder
   
   strSubject = Mail.Subject
   f = strSubject
   
   Set objFileSys = CreateObject("Scripting.FileSystemObject")

   If Right(strPath, 1) <> "\" Then
      strPath = strPath & "\"
   End If

   strNewFolder = "Z:\OPERATIO\AS400_Report\" & f & "\"
   Do Until strPath = strNewFolder
      strNewFolder = Left(strPath, InStr(Len(strNewFolder) + 1, strPath, "\"))
    
      If objFileSys.FolderExists(strNewFolder) = False Then
       [highlight #FCE94F]  objFileSys.CreateFolder (strNewFolder)[/highlight][highlight #FCE94F][/highlight]
      End If
   Loop
End Sub

when i mouse over it says strNewFolder = "

 

[strongm]

I'm afraid I can't really help here. You seem keep changing your mind about which bits of code you are going to use and which bits you are not in between posts, which makes it impossible to provide any analysis or guidance.

For the record, the exact code you posted 25 Feb 14 11:18 works absolutely fine in my copy of Outlook 2010 - it creates the folders, and it saves the attachment in the correct place.

 

[Jellybrain]

I would like to thank everyone for their help on here STRONGM and Andrzejek both! You both were Right 11:18 worked.... i left an "s" off reports (it was something simple Andrzejek) and it created a new folder further up the tree that i didn't back out far enough to see until this morning when i looked at i fresh. THANK YOU VERY MUCH