Compile Error - Outlook Redemption

Try replacing:
    Set oItem = Application.Session.GetFolderFromID("\\My Archive\Inbox")
with
    Set oItem = Application.Session.folders("My Archive").folders("Inbox")

The method of addressing folders other than default is different and this one way to do it and keep similarity with your thoiught processes

Chris

Nope, on the line:-
            Set oItem = Application.Session.Folders("My Archive").Folders("Inbox")

I get the error message:-
            Run-time error '13':
            Type mismatch

Sub testImport()
    Dim sItem, oItem As MailItem
    Dim olkPutFolder As Outlook.MAPIFolder
    
    Set sItem = CreateObject("Redemption.SafeMailItem")

    Set oItem = Application.Session.Folders("My Archive").Folders("Inbox")
  
    sItem.Item = oItem
    sItem.Import "D:\Inbox\00032847-4610-11df-a187-8147de86047f.msg"
    
    sItem.Save
End Sub

Select allOpen in new window

hmm, after a bit of playing, this works:-
                Dim sItem, oItem
                Set sItem = CreateObject("Redemption.SafeMailItem")
                Set oItem = Application.Session.GetDefaultFolder(16).Items.Add(6)
                sItem.Item = oItem
                sItem.Import "D:\0102bf06-436b-11df-8076-032bcd832b4e.msg", 3
                sItem.Save

But change so I can save it in a different folder so it is:-
                Dim sItem, oItem
                Set sItem = CreateObject("Redemption.SafeMailItem")
                Set oItem = Application.Session.Folders("My Archive").Folders("Inbox")
                sItem.Item = oItem
                sItem.Import "D:\0102bf06-436b-11df-8076-032bcd832b4e.msg", 3
                sItem.Save

And it doesnt

The error message from above code I get is:-
                 Run-time error '-2147418113(8000ffff)': Unable to access IMessage

I'm confused:

Nope, on the line:-
            Set oItem = Application.Session.Folders("My Archive").Folders("Inbox")

I get the error message:-
            Run-time error '13':
            Type mismatch
but now you are reporting
Run-time error '-2147418113(8000ffff)': Unable to access IMessage with the same line.

Which line is failing now and or can you clarify because unlless the folder names are wrong the line i provided does work.  Can you provide a snapshot of the folders?

Chris

It fails on the line " Set oItem = Application.Session.Folders("My Archive").Folders("Inbox")", Ive just thought that it could be because Im running Outlook 2010 beta, so will re-install office 2007 tomorrow and try again.

Hopefully this will work.

Thank you for your time anyways, Ill let you know if thats the issue for future reference!

I doubt it personally ... put the cursor in the inbox from my archive then in vbe immediate window, (ctrl + G to display) type:

application.ActiveExplorer.CurrentFolder.FolderPath

WHat do you get?

Chris

Good morning,
When i type it in, and press enter I get:-
          Compile error: Invalid use of propert

Good morning yourself.  In that case there is a fundamental issue ... the command works for sure in 2003 and 2007.  You have selected an item in the outlook window in that specific inbox and typed the supplied string in teh immediate window?

Note it may another error in teh code that generates the message so comment any lines highlighted in red then try again

Chris

Hmm, whats intresting is Ive just written a quick sub:-
 Sub test()
    Debug.Print Application.ActiveExplorer.CurrentFolder.FolderPath
 End Sub

And it outputs:-
          \\My Archive\Inbox

That supports the error reported was another line of code in your code modules.  Unfortunately that confirms your path is correct, (had to check!).

Do you have just the one pst named my archive?

Chris

I have my main mailbox and then this 'Archive' PST.

Ive just tried this code on Outlook 2007 and didnt work, same issues!

So by using this code:-
    Sub testImport2()
        Dim session, msg
   
        Set session = CreateObject("Redemption.RDOSession")
        session.MAPIOBJECT = Application.session.MAPIOBJECT
       
        Set msg = Application.session.Folders("My Archive").Folders("Inbox")
        msg.Import "D:\0102bf06.msg", 3
        msg.Save
    End Sub

I get the error message:-
          Run-time error '438:
          Object doesn't support this property or method




When I try this code:-
    Sub testImport()
        Dim sItem, oItem
   
        Set sItem = CreateObject("Redemption.SafeMailItem")
   
        Set oItem = Application.session.Folders("My Archive").Folders("Inbox")
   
        sItem.Item = oItem
        sItem.Import "D:\0102bf06.msg", 3
   
        sItem.Save
    End Sub

I get:-
          Run-time error '-2147418113 (8000ffff)':
          Unable to access IMessage

What Ive done to get this working is attached, however it seems to only move 1 email at a time, if there is 2 emails in the draft folder (which there shouldnt be) it only moves one of them, where I thought the code
    For Each olkItem In olkFolder.Items
        olkItem.Move olkArchiveFolder
    Next

Would move every email in the folder.

Sub testImport()
    Dim session, msg

    Set session = CreateObject("Redemption.RDOSession")
    session.MAPIOBJECT = Application.session.MAPIOBJECT
    
    Set msg = session.GetDefaultFolder(16).Items.Add(6)

    msg.Import "D:\0102bf06-436b-11df-8076-032bcd832b4e.msg", 3
    msg.Save
    
    Set olkFolder = Application.session.GetDefaultFolder(olFolderDrafts)
    Set olkArchiveFolder = OpenOutlookFolder("\\My Archive\Inbox")
     
    For Each olkItem In olkFolder.Items
        olkItem.Move olkArchiveFolder
    Next
End Sub

Function IsNothing(obj)
  If TypeName(obj) = "Nothing" Then
    IsNothing = True
  Else
    IsNothing = False
  End If
End Function
 
Function OpenOutlookFolder(strFolderPath As String) As Outlook.MAPIFolder
    Dim arrFolders As Variant, _
        varFolder As Variant, _
        olkFolder As Outlook.MAPIFolder
    On Error GoTo ehOpenOutlookFolder
    If strFolderPath = "" Then
        Set OpenOutlookFolder = Nothing
    Else
        Do While Left(strFolderPath, 1) = "\"
            strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
        Loop
        arrFolders = Split(strFolderPath, "\")
        For Each varFolder In arrFolders
            If IsNothing(olkFolder) Then
                Set olkFolder = session.Folders(varFolder)
            Else
                Set olkFolder = olkFolder.Folders(varFolder)
            End If
        Next
        Set OpenOutlookFolder = olkFolder
    End If
    On Error GoTo 0
    Exit Function
ehOpenOutlookFolder:
    Set OpenOutlookFolder = Nothing
    On Error GoTo 0
End Function

Select allOpen in new window

Thanks for your help!