Converting VBA Script to Exchange Script (Public Folder)

Posted on 2006-03-21
Last Modified: 2010-08-05
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
                    'Remove attachement
                    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>"
                    End If
                    AddLogEntry FilePath_Logfile, Null, "Attachment saved:" & strFile
                    'Improper file attachement type
                    AddLogEntry FilePath_Logfile, Null, "***Invalid attachment " & objAttachments.Item(ItemNo).FileName & " in '" & oMail.Subject & "'"
                End If
            Next ItemNo
            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
Question by:BPeb
    LVL 76

    Accepted Solution

    You cannot run code "inside" a public folder.  You can run code against the contents of a public folder, but it'd have to run from a workstation where Outlook was open and running.  I'm not sure that's what you want.  The only way to have code running at the Exchange server is to write it as an "event-sink".  Event-sinks are essentially macros running at the Exchange level.  They are more complex than Outlook macros and any mistakes in the code will affect the entire Exchange server, not one account or mailbox.  If you want to install Outlook on the Exchange server, or if it's already installed there, then you could write this code as VBScript or even a full VB program and run it automatically when the server is logged in.  It wouldn't be an event-sink, but it would not depend on a workstation and Outlook being open an running.

    To run the code against a public folder instead of your inbox requires a bit of extra code (below) and modifying one line of your code.  Specifically, change this line

        Set olFld = olNS.GetDefaultFolder(olFolderInbox)


        Set olFld = OpenMAPIFolder("\Public Folders\All Public Folders\My Public Folder")

    Here's the additional code you need.

    'Credit where credit is due.
    'The code below is not mine.  I found it somewhere on the internet but do
    'not remember where or who the author is.  The original author(s) deserves all
    'the credit for these functions.
    Function OpenMAPIFolder(szPath)
        Dim app, ns, flr, szDir, i
        Set flr = Nothing
        Set app = CreateObject("Outlook.Application")
        If Left(szPath, Len("\")) = "\" Then
            szPath = Mid(szPath, Len("\") + 1)
            Set flr = app.ActiveExplorer.CurrentFolder
        End If
        While szPath <> ""
            i = InStr(szPath, "\")
            If i Then
                szDir = Left(szPath, i - 1)
                szPath = Mid(szPath, i + Len("\"))
                szDir = szPath
                szPath = ""
            End If
            If IsNothing(flr) Then
                Set ns = app.GetNamespace("MAPI")
                Set flr = ns.Folders(szDir)
                Set flr = flr.Folders(szDir)
            End If
        Set OpenMAPIFolder = flr
    End Function

    Function IsNothing(obj)
      If TypeName(obj) = "Nothing" Then
        IsNothing = True
        IsNothing = False
      End If
    End Function

    LVL 5

    Author Comment

    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.
    LVL 76

    Expert Comment

    by: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()
        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

    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    Do email signature updates give you a headache?

    Constantly trying to correctly format email signatures? Spending all of your time at every user’s desk to make updates? Want high-quality HTML signatures on all devices, including on mobiles and Macs? Then, let Exclaimer solve all your email signature problems today!

    Email signatures have numerous marketing benefits. Here are 8 top reasons to turn your email signature into a marketing channel.
    "Migrate" an SMTP relay receive connector to a new server using info from an old server.
    In this video we show how to create an Accepted Domain in Exchange 2013. We show this process by using the Exchange Admin Center. Log into Exchange Admin Center.: First we need to log into the Exchange Admin Center. Navigate to the Mail Flow >> Ac…
    In this video we show how to create an email address policy in Exchange 2013. We show this process by using the Exchange Admin Center. Log into Exchange Admin Center.:  First we need to log into the Exchange Admin Center. Navigate to the Mail Flow…

    760 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    10 Experts available now in Live!

    Get 1:1 Help Now