asked on

Converting VBA Script to Exchange Script (Public Folder)

Recently I needed to write code to save and remove certain attachaments from incoming emails. I wrote the code in my personal Outlook account and it works well. The assumption when I wrote did this was that the administrator would create dedicated account and I'd drop it there all would be fine, but nope, the admin wants to use a public folder instead.

Though I have lots of VBA experience I'm new to Outlook/Exchange coding, but I have been able to get the code I need figured so far. But I need tips on converting my code to run in a public folder (I have admin rights to the folder).

So far I've been able to figure out that I need the following subs and that my code has to be in the 'ItemAdd' sub, but what do I need to change in the real code below to make it run in a public folder? I have some ideas, but I don't want to destroy what works without some idea of where I'm going first. Tips, suggestions, links, samples?

Thanks for looking, hope you can help.

== I know I need these ===
Private Sub Application_Quit()
Private Sub Application_Startup()
Private Sub oFolder_ItemAdd(ByVal Item As Object)

== Code I need to convert ===
Private Sub Application_NewMail()
Dim olApp As Outlook.Application, olNS As Outlook.NameSpace, objMsg As Outlook.MailItem
Dim olFld As Outlook.MAPIFolder, oMail As Outlook.MailItem, objAttachments As Outlook.Attachments
Dim strFile As String, ItemNo As Long, AttachNo As Long

'Use Application object to avoid macro warning message to user
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olFld = olNS.GetDefaultFolder(olFolderInbox)
olFld.Items.Sort "Received", False
If olFld.Items(1).Class = olMail Then 'Must be a mail object
Set oMail = olFld.Items.GetFirst
Set objAttachments = olFld.Items(1).Attachments
AddLogEntry FilePath_Logfile, "Processing email '" & oMail.Subject & "' from " & oMail.SenderName, Null
If objAttachments.Count > 0 Then 'Must have an attachement
AttachNo = objAttachments.Count
For ItemNo = 1 To AttachNo
strFile = Trim(objAttachments.Item(1).FileName)
If Right$(strFile, 3) = "txt" Then
strFile = FilePath_Out & strFile
If Len(Dir(strFile)) > 0 Then
MoveFile FilePath_Out & Trim(objAttachments.Item(1).FileName), FilePath_BackUp & Trim(objAttachments.Item(1).FileName)
End If
objAttachments.Item(1).SaveAsFile strFile
objAttachments.Item(1).Delete
'Remove attachement
If oMail.BodyFormat <> olFormatHTML Then
oMail.Body = oMail.Body & vbCrLf & "Attachment saved:" & vbCrLf & strFile
Else
oMail.HTMLBody = oMail.HTMLBody & "<p>" & "Attachment saved:" & "<br>" & "<a href='file://" & strFile & "'>" & strFile & "</a>"
End If
oMail.Save
AddLogEntry FilePath_Logfile, Null, "Attachment saved:" & strFile
Else
'Improper file attachement type
AddLogEntry FilePath_Logfile, Null, "***Invalid attachment " & objAttachments.Item(ItemNo).FileName & " in '" & oMail.Subject & "'"
End If
Next ItemNo
Else
AddLogEntry FilePath_Logfile, Null, "***No attachments found in '" & oMail.Subject & "'"
End If
End If
Set oMail = Nothing
Set olFld = Nothing
Set olNS = Nothing
Set olApp = Nothing
End Sub

ASKER CERTIFIED SOLUTION

David Lee

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

BPeb

ASKER

I've seen that code and your helpful comments too on other similar questions.

I'm now thinking that the best way to handle this is to go to VB6 and write a monitoring exe. I've seen code to do this elswhere and have made a stab at it, but am getting an error message about an object required even though I'm pretty sure I have all me references selected.

Oh well, I'll solve that tomorrow.

Thanks for responding.

David Lee

Using VB6 would be a good solution. You'll still have to have Outlook on the computer this runs on, but Outlook won't need to be open and running. If you try and run your code as is from VB6, then I would expect it to have a problem. The subs/functions that begin with Application_ will only work when run from inside Outlook. In VB6 there is not Application object that refers to the Outlook application. Also, if this is going to run against a public folder, then the NewMail event isn't what you need. Instead, you'll need to trap the ItemAdd event on the folder object. Basically, something like this:

Dim olApp As Outlook.Application, _
olNS As Outlook.NameSpace, _
WithEvents olPublicFolder As Outlook.Items

Private Sub Form_Load()
Set olApp = CreateObject("Outlook.Application")
Set olNS = olApp.GetNamespace("MAPI")
olNS.Logon "ProfileName", "password", False, True
Set olPublicFolder = OpenMAPIFolder("\Public Folders\All Public Folders\My Public Folder").Items
End Sub

Private Sub Form_Terminate()
olNS.Logoff
Set olNS = Nothing
Set olApp = Nothing
End Sub

Private Sub olPublicFolder_ItemAdd(ByVal Item As Object)
'Your code goes here. You don't need all the code you had before, just
'that portion that process the individual item that arrived in the mailbox and
'triggered this event.
End Sub