Outlook 2010 Script Rule (multiple Email inbox's)

[Jellybrain]

Objective use Virtual PC to Folder Different types of PDF's on one instance of Outlook 2010 with two email inboxes. using different email Rules to run scripts.
Situation Facts:
Fact#1: two email address AS400Reports@mydomain.com; and PoolReports@mydomain.com
Fact#2: Virtual PC specifically used for foldering PDF attachments coming into As400Reports@mydomain.com
Fact#3: PoolReports is now a shared mailbox for User "AS400Reports" and shows up in outlook 2010
Fact#4: doing this (adding shared mailbox) has messed up my previous VBscript to run when rule calls upon it. "outlook cannot delete this item"
Fact#5: I need to make it so my new VBscript Rule runs only on emails in the shared inbox. it works when i run it manually except for same "cannot delete" message. (line 30 in code below)

Okay so here are my dilemmas:
#1 how do i fix the delete (move to deleted items) email issue?

( I assume it will be the same for both)​

I also assume it has to have folder mapping but i am a newbie with VB of any type​

#2 (referring to fact#5) how do i get my rule to run automatically in the second email inbox?

No assumptions on my behalf here.​

Public Sub SvPoolTest1(mail As Outlook.MailItem)
'this works when ran manually but outlook can not delete the items. This also affected the other "saveattachments2" for as400 reports as there are now multiple inboxes and multiple deleted items
' need to work on automatically running in diff inbox and fix deleting email issues
On Error GoTo GetAttachments_err:

1 Dim Atmt As Attachment
2 Dim FileName As String
3 Dim i As Integer
4 Set fso = CreateObject("Scripting.FileSystemObject")

6 f = DateSerial(Year(Now), Month(Now) - 1, Day(Now))
'for line 6 - folder naming - since we work with previous months data the "-1" was added
7 m = Month(f) 'folder naming
8 nm = MonthName(m, False) 'folder naming
9  y = Year(f) 'folder naming

11 Z = Format(f, "YYYY.MM") 'folder naming
12 d = Format(f, "DD") ' just in case i need it for folder naming

'check for date received to apply specific foldering
13 mrt = mail.ReceivedTime ' includes time stamp as well
14 mrtf = Format(mrt, "DD")
  ' MkDir ("Z:\AUDIT\...")
Dim q As String
If mrtf <= 15 Then
'if the day of the month is less than or equal to the 15th it will folder to the 10th pool folder
    q = "AS400_PDF_Pool_Reports"
    Else
    'if the day of the month is greater than the 15th it will folder to the 20th pool folder
    q = "AS400_PDF_Pool_Reports_20th"
    End If
'"q" is the 10th or 20th pool reports folder determined by above IF then else statment

20 StrFolderPath = "Z:\AUDIT\" & q & "\" & y & "\" & Z & "_" & nm & "\"
21 myCreateFolder StrFolderPath



24 For Each Atmt In mail.Attachments
'Z:\AUDIT\AS400_PDF_Pool_Reports
If mrtf <= 15 Then
26 FileName = "Z:\AUDIT\AS400_PDF_Pool_Reports\" & y & "\" & Z & "_" & nm & "\" & Atmt.FileName
'popup window to confirm its working for now. (currently commented out)
MsgBox StrFolderPath & Atmt.FileName, vbOKOnly, "What and Where"
27 Atmt.SaveAsFile FileName
28 i = i + 1
Else
22 FileName = "Z:\AUDIT\AS400_PDF_Pool_Reports_20th\" & y & "\" & Z & "_" & nm & "\" & Atmt.FileName
'popup window to confirm its working for now. (currently commented out)
MsgBox StrFolderPath & Atmt.FileName, vbOKOnly, "What and Where"
23 Atmt.SaveAsFile FileName
33 i = i + 1
End If

'to move to deleted items folder
29 Next Atmt
30 mail.Delete
31 GetAttachments_exit:
32 Set Atmt = Nothing

Exit Sub


GetAttachments_err:
If Err.Number <> 0 Then
42:     Msg = "Error # " & Str(Err.Number) & " was generated by " _
         & Err.Source & Chr(13) & "Error Line: " & Erl & Chr(13) & Err.Description
      MsgBox Msg, , "Error"
44:     End If

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
'thanks to [URL unfurl="true"]http://www.tek-tips.com/viewthread.cfm?qid=1727511[/URL]
'they helped me figure out what was wrong with the creating folder path on the previous code

 

[Jellybrain]

Placed in wrong section