Converting VBA Script to Exchange Script (Public Folder)
Posted on 2006-03-21
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)
If oMail.BodyFormat <> olFormatHTML Then
oMail.Body = oMail.Body & vbCrLf & "Attachment saved:" & vbCrLf & strFile
oMail.HTMLBody = oMail.HTMLBody & "<p>" & "Attachment saved:" & "<br>" & "<a href='file://" & strFile & "'>" & strFile & "</a>"
AddLogEntry FilePath_Logfile, Null, "Attachment saved:" & strFile
'Improper file attachement type
AddLogEntry FilePath_Logfile, Null, "***Invalid attachment " & objAttachments.Item(ItemNo).FileName & " in '" & oMail.Subject & "'"
AddLogEntry FilePath_Logfile, Null, "***No attachments found in '" & oMail.Subject & "'"
Set oMail = Nothing
Set olFld = Nothing
Set olNS = Nothing
Set olApp = Nothing