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
