Drag and Drop autoresponse emails - More help needed

Original Question...

http://www.experts-exchange.com/Applications/MS_Office/Outlook/Q_21916262.html

Follow up question...

http://www.experts-exchange.com/Programming/Programming_Languages/Visual_Basic/Q_21927036.html

--------------------------------------------------------------------------------------------------------------------------
New Question...
I will be copying the OTM file to everyones Microsoft/Outlook directory, but specified in the code is the location of my specific mailbox, is there a way to set this up so it can be universal, so the code is relevent to who ever is logged in?


Second Question..
Doesn't seem to work in Outlook 2000.
Error:

Compile error:
Can't find project or library.
Antonio KingIT ManagerAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

David LeeCommented:
Greetings, Alan-Yeo.

> is there a way to set this up so it can be universal, so the code is
> relevent to who ever is logged in?
That depends on your environment.  If you are on a Windows network, then yes.  Otherwise, there may be, but I can't say for sure without knowing more about your environment.

> Second Question.
What line is generating the error?

Cheers!
Antonio KingIT ManagerAuthor Commented:
We are a windows network!

Its line...

Function OpenMAPIFolder(szPath)
David LeeCommented:
Okay, try adding the code below.  It grabs the name of your Inbox folder's parent folder which should be the root of the current user's mailbox.  Now replace this line of code from what you have

    Set olkFolder = OpenMAPIFolder("\FolderName\SubFolderName").Items

with

    Set olkFolder = OpenMAPIFolder(GetRootFolder() & "\SubFolderName").Items

Function GetRootFolder()
    Dim olkRoot As Outlook.MAPIFolder
    Set olkRoot = Session.GetDefaultFolder(olFolderInbox).Parent
    GetRootFolder = "\" & olkRoot.Name
    Set olkRoot = Nothing
End Function


Where in your code have you placed the OpenMAPIFolder function?
Become a Certified Penetration Testing Engineer

This CPTE Certified Penetration Testing Engineer course covers everything you need to know about becoming a Certified Penetration Testing Engineer. Career Path: Professional roles include Ethical Hackers, Security Consultants, System Administrators, and Chief Security Officers.

Antonio KingIT ManagerAuthor Commented:
Works a treat.

My code looks like this...

Private WithEvents olkFolder1 As Outlook.Items, _
    WithEvents olkFolder2 As Outlook.Items, _
    WithEvents olkFolder3 As Outlook.Items

Private Sub Application_Startup()
    'Change the path of the folder to watch
    Set olkFolder1 = OpenMAPIFolder(GetRootFolder() & "\Inbox\Application Accept").Items
    Set olkFolder2 = OpenMAPIFolder(GetRootFolder() & "\Inbox\Application Reject").Items
    Set olkFolder3 = OpenMAPIFolder(GetRootFolder() & "\Inbox\Application Reject - Work Permit").Items
End Sub

Function GetRootFolder()
    Dim olkRoot As Outlook.MAPIFolder
    Set olkRoot = Session.GetDefaultFolder(olFolderInbox).Parent
    GetRootFolder = "\" & olkRoot.Name
    Set olkRoot = Nothing
End Function

Private Sub Application_Quit()
    Set olkFolder1 = Nothing
    Set olkFolder2 = Nothing
    Set olkFolder3 = Nothing
End Sub

Private Sub olkFolder1_ItemAdd(ByVal Item As Object)
    Dim olkMessage As Outlook.MailItem
    If MsgBox("Are you sure you want to send an application accept email to " & Item.SenderName & "?", vbYesNo, "Confirm Send") = vbYes Then
        Set olkMessage = Application.CreateItemFromTemplate("H:\UTILITY\Support\Drop Email Templates\ApplicationAccept.oft")
        With olkMessage
            .Recipients.Add Item.SenderEmailAddress
            .Send
        End With
    Else
        Item.Move Session.GetDefaultFolder(olFolderInbox)
    End If
    Set olkMessage = Nothing
End Sub


Private Sub olkFolder2_ItemAdd(ByVal Item As Object)
    Dim olkMessage As Outlook.MailItem
    If MsgBox("Are you sure you want to send an application reject email to " & Item.SenderName & "?", vbYesNo, "Confirm Send") = vbYes Then
        Set olkMessage = Application.CreateItemFromTemplate("H:\UTILITY\Support\Drop Email Templates\ApplicationReject.oft")
        With olkMessage
            .Recipients.Add Item.SenderEmailAddress
            .Send
        End With
    Else
        Item.Move Session.GetDefaultFolder(olFolderInbox)
    End If
    Set olkMessage = Nothing
End Sub

Private Sub olkFolder3_ItemAdd(ByVal Item As Object)
    Dim olkMessage As Outlook.MailItem
    If MsgBox("Are you sure you want to send an application reject email to " & Item.SenderName & "?", vbYesNo, "Confirm Send") = vbYes Then
        Set olkMessage = Application.CreateItemFromTemplate("H:\UTILITY\Support\Drop Email Templates\ApplicationRejectWorkPermit.oft")
        With olkMessage
            .Recipients.Add Item.SenderEmailAddress
            .Send
        End With
    Else
        Item.Move Session.GetDefaultFolder(olFolderInbox)
    End If
    Set olkMessage = Nothing
End Sub

'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)
    Else
        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("\"))
        Else
            szDir = szPath
            szPath = ""
        End If
        If IsNothing(flr) Then
            Set ns = app.GetNamespace("MAPI")
            Set flr = app.GetNamespace("MAPI").Folders(szDir)
        Else
            Set flr = flr.Folders(szDir)
        End If
    Wend
    Set OpenMAPIFolder = flr
End Function

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



Antonio KingIT ManagerAuthor Commented:
Any ideas on this outlook 2000 error?
David LeeCommented:
I was waiting for the answer to my last question.  "Where in your code have you placed the OpenMAPIFolder function?"
Antonio KingIT ManagerAuthor Commented:
I've posted all the code so you can see where it is!?
David LeeCommented:
Sorry, I wasn't clear.  When you're in the VBA editor in Outlook is all the code in the same module or are they in different modules?  If the latter, which module is OpenMAPIFolder in?
Antonio KingIT ManagerAuthor Commented:
Same module.
David LeeCommented:
Try replacing the OpenMAPIFolder function in its entirety with the version below.  Then try the code in 2000 and let me know what happens.

Function OpenMAPIFolder(strFolderPath As String) As Object
    Dim arrFolders As Variant, _
        intIndex As Integer, _
        olkFolder As Outlook.MAPIFolder
    On Error GoTo ehOpenOutlookFolder
    If strFolderPath = "" Then
        Set OpenMAPIFolder = Nothing
    Else
        If Left(strFolderPath, 1) = "\" Then
            strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
        End If
        arrFolders = Split(strFolderPath, "\")
        For intIndex = LBound(arrFolders) To UBound(arrFolders)
            If IsNothing(olkFolder) Then
                Set olkFolder = Session.Folders(arrFolders(intIndex))
            Else
                Set olkFolder = olkFolder.Folders(arrFolders(intIndex))
            End If
        Next
        Set OpenMAPIFolder = olkFolder
    End If
    On Error GoTo 0
    Exit Function
ehOpenOutlookFolder:
    Set OpenMAPIFolder = Nothing
    On Error GoTo 0
End Function
Antonio KingIT ManagerAuthor Commented:
still doesnt work. Same line is highlighted when debugging.
"Function OpenMAPIFolder(strFolderPath As String) As Object"

:(
David LeeCommented:
Try moving OpenMAPIFolder and IsNothing to a different module.
Antonio KingIT ManagerAuthor Commented:
Still no change... :'(
David LeeCommented:
I don't know how to proceed.  I don't have Outlook 2000 anymore so I'm not in a position to model what's going on.  I have used OpenMAPIFolder in other questions involving Outlook 2000 and it has worked.  So it's not a situation where the code just won't work with that version of Outlook.  Let's try this.  In the VB Editor click Tools->References.  Scroll through the list of available items and let me know if any of them have "Missing" next to them.
Antonio KingIT ManagerAuthor Commented:
Yes...

MISSING Microsoft Office 11.0 Object Library
David LeeCommented:
Ok.  Uncheck it, 11.0 is Office 2003, and find and check Microsoft Office 9.0 Object Library (that should be 2000).  Then try the code again.
Antonio KingIT ManagerAuthor Commented:
Righteo, Unchecked..

When I drop an email into any of the folders I get this...

Run-Time error '438':

Object doesn't support this property or method


hit Debug and line...

.Recipients.Add Item.SenderEmailAddress

is highlighted.
David LeeCommented:
Try substituting SenderName in place of SenderEmailAddress in the line highlighted by the error.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Antonio KingIT ManagerAuthor Commented:
Fantastic!!! Works in both Office 2000 and 2003 now... thank you very much for all your help.
David LeeCommented:
Cool!  You're welcome.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Outlook

From novice to tech pro — start learning today.