Need a macro for office outlook 2003

[printline]

Hello

I have the following macro for outlook:

Dim oApp As Application
Dim oNS As NameSpace
Dim oMsg As Object
Dim bDoAction As Boolean
Dim oAttachments As Outlook.Attachments
Dim iSubject, dirPath, tu, hu, tot, Rcp As String
Dim i, iAttachCnt As Integer
 
 
'Counting files
Private Function CountFiles(ByVal folderPath As String, Optional ByVal fileType As String = "*")
 
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Dim count As Long
    Set oFolder = oFSO.GetFolder(folderPath)
    Set oFiles = oFolder.Files
 
    fileType = LCase(Trim(fileType))
 
    If fileType = "*" Then
        CountFiles = oFiles.count
    Else
        For Each oFile In oFiles
            If LCase(oFSO.GetExtensionName(oFile.Name)) = fileType Then count = count + 1
        Next oFile
        CountFiles = count
   End If
 
End Function
Sub JobScanning()
 
 
    '*************
    ' Finding files in PTA emails and saves them respective folder
    ' Objective:
    ' Save email and attachments in respektive folders
    '*************
 
    Set oApp = New Outlook.Application
    Set oNS = oApp.GetNamespace("MAPI")
 
    Set oFolder = oNS.Folders("Public Folders").Folders("All Public Folders").Folders("PTA").Folders("JobScanning")
 
    For Each oMsg In oFolder.Items
        bDoAction = True
        With oMsg
        'tot = the first 5 characters in subject
        tot = Left(.Subject, 5)
            If Val(tot) > 7999 Then
                'isubject = whole subject
        iSubject = .Subject
        'tu = first 2 characters in subject
                tu = Left(.Subject, 2)
        'hu = first 3 characters in subject
                hu = Left(.Subject, 3)
 
        'building folder path
                dirPath = "j:\job\" & tu & "000-" & tu & "999\" & hu & "00-" & hu & "99\" & tot & "\"
                If CountFiles(dirPath) > 1 Then
                        'warning
            If MsgBox("there is" & CountFiles(dirPath) & " files in folder" & tot & "\, ", 49, "PTA emails - warning") = vbCancel Then bDoAction = False
                End If
 
 
 
 
                    '***********
                    ' saving attachments in folders
                    '***********
                    iAttachCnt = .Attachments.count
                    If iAttachCnt > 0 Then
                        For iCtr = 1 To iAttachCnt
                            With .Attachments.Item(iCtr)
                                    .SaveAsFile dirPath & .FileName
                            End With
                        Next iCtr
                    End If
                    'deleting email
            .delete
           End If
 
        End With
    Next
End Sub
 
 
 
 

Now i need to do exactly the same again in a new macro but instead of looking at the subject name characters i need to be looking at attach file name characters. Can anyone help with this problem...????

Thanks in advance