James,

Thanks for your PM. I actually never saw Killian's kind addition regarding the loop, so I'm sure you could use that as well. Either way, here is my code for the Userform part

[VBA]'module level variable for the attchment
Private myAttachment As Attachment
Private myFolder As Object
Private myItem As MailItem

Property Let SourceItem(i As MailItem)
Set myItem = i
If i.Attachments.Count = 0 Then
lblAttName.Caption = "Mail item"
End If
End Property
Property Let AttachedFile(a As Attachment)
'this property is passed for each attachment from
'the calling class cItems so we have a reference
'to each attachment the form is dealing with
Set myAttachment = a
'I have a label "lblAttName" to display the
'file we're currently working with
If myAttachment = "Picture (Device Independent Bitmap)" Then
lblAttName.Caption = "FaxPicture"
Else
lblAttName.Caption = myAttachment.FileName
End If
End Property

Private Sub CheckBox1_Click()
If CheckBox1.Enabled = True Then
OptNameBox.Value = ComboYear.Value & "-" & ComboMonth.Value & " "
Else
OptNameBox.Value = ""
End If
End Sub

Private Sub ComboMonth_Change()
End Sub
Private Sub ComboYear_Change()
End Sub
Private Sub FileType_Change()
If FileType.Value = "FileType" Then
OptNameBox.Value = ""
Else
OptNameBox.Value = ComboYear.Value & "-" & ComboMonth.Value & " " & FileType.Value
End If
End Sub
Private Sub OptNameBox_Change()
End Sub
Private Sub OptOn_Click()
End Sub
Private Sub UserForm_Initialize()
'a combobox called "cboAttType" for each of the file types
With OptOn = True
End With
With FileType
.AddItem "FileType"
.AddItem "Report"
.AddItem "Letter"
.AddItem "Exposure"
.AddItem "Performance"
.AddItem "Commentary"
.Value = "FileType"
.ListIndex = 0

End With

With cboAttType
.AddItem "Cap Acct Statements"
.AddItem "Financials"
.AddItem "Investor Reporting"
.AddItem "Performance"
.AddItem "Due Diligence"
.AddItem "Correspondence"
.AddItem "Wires"
.AddItem "Legal"
.AddItem "Manager Materials"
.ListIndex = 0
End With

With ComboMonth
.AddItem "05"
.AddItem "04"
.AddItem "03"
.AddItem "02"
.AddItem "01"
.AddItem "12"
.AddItem "11"
.AddItem "10"
.AddItem "09"
.AddItem "08"
.AddItem "07"
.AddItem "06"
.ListIndex = 0
.Value = "05"
End With
With ComboYear
.AddItem "2006"
.AddItem "2005"
.AddItem "2004"
.AddItem "2003"
.Value = "2006"
End With
With ComboFin
.AddItem "K1"
.AddItem "FS"
.Value = "FS"
End With

End Sub
Private Sub cmdOK_Click()
Dim strPathPrefix As String
Dim SavedFileName As String
Dim SubjectText As String
If lblAttName.Caption = "Mail item" Then
SubjectText = myItem.Subject
If (SubjectText Like "*:*") Or (SubjectText Like "*>*") Or (SubjectText Like "*;*") _
Or (SubjectText Like "*=*") Or (SubjectText Like "*\*") Or (SubjectText Like "*<*") _
Or (SubjectText Like "*>*") Or (SubjectText Like "*+*") Or (SubjectText Like "*]*") Then
' Or (SubjectText Like "*[*") <---- IT DOESN'T SEEM TO LIKE THIS
Resp = MsgBox("Invalid Characters in Subject", vbOKOnly)
Unload Me
Exit Sub
End If
Else
SavedFileName = myItem.Subject
End If
If lblAttName.Caption <> "Mail item" Then
SavedFileName = myAttachment.FileName
End If
If OptNameBox.Value = "" Then
Else
SavedFileName = OptNameBox.Value
End If
If Me.OptOn Then 'OnShore
strPathPrefix = myItem.Parent.Description
ElseIf Me.OptOff Then 'OffShore
strPathPrefix = myItem.Parent.WebViewURL
End If
If lblAttName.Caption = "FaxPicture" Then
Unload Me
Else
End If

If cboAttType.Value = "Financials" Then
myAttachment.SaveAsFile strPathPrefix & cboAttType.Value & "\" & ComboYear.Value & " " & ComboFin.Value & Right(myAttachment.FileName, 4)
Unload Me
Exit Sub
End If


If lblAttName.Caption = "Mail item" And cboAttType.Value <> "Cap Acct Statements" Then
myItem.SaveAs strPathPrefix & cboAttType.Value & "\" & SavedFileName & " " & Format(myItem.ReceivedTime, "mmddyy") & ".msg"
Unload Me
Exit Sub
End If

If lblAttName.Caption = "Mail item" And cboAttType.Value = "Cap Acct Statements" Then
If Len(Dir(strPathPrefix & cboAttType.Value & "\" & ComboYear.Value & "-" & ComboMonth.Value & ".msg")) > 0 Then
Resp = MsgBox("Overwrite file?", vbYesNo)
If Resp = vbYes Then
myItem.SaveAs strPathPrefix & cboAttType.Value & "\" & ComboYear.Value & "-" & ComboMonth.Value & ".msg"
Unload Me
Else
myItem.SaveAs strPathPrefix & cboAttType.Value & "\" & ComboYear.Value & "-" & ComboMonth.Value & Format(myItem.ReceivedTime, " hhnnss") & ".msg"
Unload Me
End If
Else
myItem.SaveAs strPathPrefix & cboAttType.Value & "\" & ComboYear.Value & "-" & ComboMonth.Value & ".msg"
Unload Me
End If
Unload Me
Exit Sub
End If



If lblAttName.Caption <> "Mail Item" And cboAttType.Value = "Cap Acct Statements" Then
If Len(Dir(strPathPrefix & cboAttType.Value & "\" & ComboYear.Value & "-" & ComboMonth.Value & Right(myAttachment.FileName, 4))) > 0 Then
Resp = MsgBox("Overwrite file?", vbYesNo)
If Resp = vbYes Then
myAttachment.SaveAsFile strPathPrefix & cboAttType.Value & "\" & ComboYear.Value & "-" & ComboMonth.Value & Right(myAttachment.FileName, 4)
Else
myAttachment.SaveAsFile strPathPrefix & cboAttType.Value & "\" & ComboYear.Value & "-" & ComboMonth.Value & Format(myItem.ReceivedTime, "hhnnss") & Right(myAttachment.FileName, 4)
End If
Else
myAttachment.SaveAsFile strPathPrefix & cboAttType.Value & "\" & ComboYear.Value & "-" & ComboMonth.Value & Right(myAttachment.FileName, 4)
End If
Unload Me
Exit Sub
End If

If lblAttName.Caption <> "Mail Item" And cboAttType.Value <> "Cap Acct Statements" Then
myAttachment.SaveAsFile strPathPrefix & cboAttType.Value & "\" & SavedFileName & Right(myAttachment.FileName, 4)
Unload Me
Exit Sub
End If

End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
[/VBA]

Here is my code for the cItems class module:

[VBA]Option Explicit

Public WithEvents folderitems As Items

Sub Init(i As Items)
Set folderitems = i
End Sub

Private Sub Class_Terminate()
Set folderitems = Nothing
End Sub

Private Sub folderitems_ItemAdd(ByVal Item As Object)
Dim a As Attachment
If Item.Attachments.Count > 0 Then
For Each a In Item.Attachments
UserForm1.AttachedFile = a
UserForm1.SourceItem = Item
If UserForm1.lblAttName.Caption = "FaxPicture" Then
Exit Sub
Else
UserForm1.Show
End If
Next a
ElseIf Item.Parent.ShowItemCount = olShowTotalItemCount Then ' no attachments
UserForm1.SourceItem = Item
UserForm1.Show
Else
Exit Sub
End If
End Sub
[/VBA]

And finally, here is my code for ThisOutlookSession:
[VBA]
Public FaxAtt As String
'variable to define each set of folder items as a custom class
Dim objFolderItems As cItems
'collection to hold the classes for the duration of the session
Dim colFolderItems As New Collection

Private Sub Application_Startup()
'some startup code to set our "event-sensitive" items collection
Dim ns As Outlook.NameSpace
Dim f 'each folder

Set ns = Application.GetNamespace("MAPI")

For Each f In ns.Folders.Item(".FAGE").Folders
Set objFolderItems = New cItems
objFolderItems.Init f.Items
colFolderItems.Add objFolderItems
Next f

For Each f In ns.Folders.Item(".FASS").Folders
Set objFolderItems = New cItems
objFolderItems.Init f.Items
colFolderItems.Add objFolderItems
Next f

For Each f In ns.Folders.Item(".FATG").Folders
Set objFolderItems = New cItems
objFolderItems.Init f.Items
colFolderItems.Add objFolderItems
Next f

For Each f In ns.Folders.Item(".FAVC").Folders
Set objFolderItems = New cItems
objFolderItems.Init f.Items
colFolderItems.Add objFolderItems
Next f
End Sub
[/VBA]

Hopefully that helps, but let me know if you need anything.