469,126 Members | 1,296 Online
Bytes | Developer Community
New Post

Home Posts Topics Members FAQ

Post your question to a community of 469,126 developers. It's quick & easy.

Need a macro for office outlook 2003

Hello

I have the following macro for outlook:

Expand|Select|Wrap|Line Numbers
  1. Dim oApp As Application
  2. Dim oNS As NameSpace
  3. Dim oMsg As Object
  4. Dim bDoAction As Boolean
  5. Dim oAttachments As Outlook.Attachments
  6. Dim iSubject, dirPath, tu, hu, tot, Rcp As String
  7. Dim i, iAttachCnt As Integer
  8.  
  9.  
  10. 'Counting files
  11. Private Function CountFiles(ByVal folderPath As String, Optional ByVal fileType As String = "*")
  12.  
  13.     Set oFSO = CreateObject("Scripting.FileSystemObject")
  14.     Dim count As Long
  15.     Set oFolder = oFSO.GetFolder(folderPath)
  16.     Set oFiles = oFolder.Files
  17.  
  18.     fileType = LCase(Trim(fileType))
  19.  
  20.     If fileType = "*" Then
  21.         CountFiles = oFiles.count
  22.     Else
  23.         For Each oFile In oFiles
  24.             If LCase(oFSO.GetExtensionName(oFile.Name)) = fileType Then count = count + 1
  25.         Next oFile
  26.         CountFiles = count
  27.    End If
  28.  
  29. End Function
  30. Sub JobScanning()
  31.  
  32.  
  33.     '*************
  34.     ' Finding files in PTA emails and saves them respective folder
  35.     ' Objective:
  36.     ' Save email and attachments in respektive folders
  37.     '*************
  38.  
  39.     Set oApp = New Outlook.Application
  40.     Set oNS = oApp.GetNamespace("MAPI")
  41.  
  42.     Set oFolder = oNS.Folders("Public Folders").Folders("All Public Folders").Folders("PTA").Folders("JobScanning")
  43.  
  44.     For Each oMsg In oFolder.Items
  45.         bDoAction = True
  46.         With oMsg
  47.         'tot = the first 5 characters in subject
  48.         tot = Left(.Subject, 5)
  49.             If Val(tot) > 7999 Then
  50.                 'isubject = whole subject
  51.         iSubject = .Subject
  52.         'tu = first 2 characters in subject
  53.                 tu = Left(.Subject, 2)
  54.         'hu = first 3 characters in subject
  55.                 hu = Left(.Subject, 3)
  56.  
  57.         'building folder path
  58.                 dirPath = "j:\job\" & tu & "000-" & tu & "999\" & hu & "00-" & hu & "99\" & tot & "\"
  59.                 If CountFiles(dirPath) > 1 Then
  60.                         'warning
  61.             If MsgBox("there is" & CountFiles(dirPath) & " files in folder" & tot & "\, ", 49, "PTA emails - warning") = vbCancel Then bDoAction = False
  62.                 End If
  63.  
  64.  
  65.  
  66.  
  67.                     '***********
  68.                     ' saving attachments in folders
  69.                     '***********
  70.                     iAttachCnt = .Attachments.count
  71.                     If iAttachCnt > 0 Then
  72.                         For iCtr = 1 To iAttachCnt
  73.                             With .Attachments.Item(iCtr)
  74.                                     .SaveAsFile dirPath & .FileName
  75.                             End With
  76.                         Next iCtr
  77.                     End If
  78.                     'deleting email
  79.             .delete
  80.            End If
  81.  
  82.         End With
  83.     Next
  84. End Sub
  85.  
  86.  
  87.  
  88.  
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
Jul 28 '09 #1
0 1471

Post your reply

Sign in to post your reply or Sign up for a free account.

Similar topics

2 posts views Thread by Thilaka | last post: by
2 posts views Thread by Miguel Arenas | last post: by
2 posts views Thread by =?Utf-8?B?SmVmZiBD?= | last post: by
1 post views Thread by CARIGAR | last post: by
reply views Thread by zhoujie | last post: by
reply views Thread by Mortomer39 | last post: by
By using this site, you agree to our Privacy Policy and Terms of Use.