none
Outlook 2010 VB script to grab a file from Public Folders RRS feed

  • Question

  • Good afternoon, gurus. I have the following code in a Access database to grab a xml file from Outlook public folders and spread the data from it into a database with a different piece of code. As soon as our company upgraded to Office 2010, it does not work anymore. Any thoughts? Please let me know.

    Regards,

    Chris

    Public Function GetXmlDocument(DocumentName As String)
    Dim mXmlDoc
    Dim mFld
    Dim MyItem
    Dim Fso
    Dim FileName As String
            On Error GoTo Err_GetXmlDocument
            InitializeOutlook
            FileName = "C" + Split(DocumentName, " - ", True, vbTextCompare)(0) + " DocumentIneed.xml"
            Set Fso = CreateObject("Scripting.FileSystemObject")
            Set mFld = GetNomtFld("Public Folders\All Public Folders\more path\folderIneed")
            If TypeName(mFld) = "Nothing" Or TypeName(mFld) = "Empty" Then
            Else
                Set MyItem = mFld.Items(FileName)
    1011:       If Fso.FileExists(Fso.BuildPath(Fso.GetSpecialFolder(2), MyItem.Attachments(1).FileName)) Then Fso.DeleteFile Fso.BuildPath(Fso.GetSpecialFolder(2), MyItem.Attachments(1).FileName), True
    1012:       MyItem.Attachments(1).SaveAsFile Fso.BuildPath(Fso.GetSpecialFolder(2), MyItem.Attachments(1).FileName)
                If Fso.FileExists(Fso.BuildPath(Fso.GetSpecialFolder(2), MyItem.Attachments(1).FileName)) Then
                    Set mXmlDoc = CreateObject("MSXML.DOMDocument")
                    mXmlDoc.Load Fso.BuildPath(Fso.GetSpecialFolder(2), MyItem.Attachments(1).FileName)
                    Set GetXmlDocument = mXmlDoc
    1013:           If Fso.FileExists(Fso.BuildPath(Fso.GetSpecialFolder(2), MyItem.Attachments(1).FileName)) Then Fso.DeleteFile Fso.BuildPath(Fso.GetSpecialFolder(2), MyItem.Attachments(1).FileName), True
    1014:       End If
            End If
    Exit_GetXmlDocument:
        Exit Function
    Err_GetXmlDocument:
        Select Case Erl
            Case 1011, 1013
                Resume Next
            Case Else
            Select Case MsgBox("Error " & Err.Number & vbLf & Err.Description, vbAbortRetryIgnore, "Module1.GetXmlDocument - " + Err.Source, Err.HelpFile, Err.HelpContext)
                Case vbAbort: Resume Exit_GetXmlDocument
                Case vbRetry: Resume
                Case vbIgnore: Resume Next
            End Select
        End Select
    End Function

    Public Function GetNomtFld(ByVal FolderPath As String)
    Dim i As Integer
    Dim TempFld
    Dim NomtFld
        InitializeOutlook
        TempFld = Split(FolderPath, "\", True, vbTextCompare)
        For i = 0 To UBound(TempFld)
            If i = 0 Then
                Set NomtFld = olNameSpace.Folders.Item(TempFld(i))
            Else
                Set NomtFld = NomtFld.Folders.Item(TempFld(i))
            End If
        Next
        Set GetNomtFld = NomtFld
    End Function

    Public Function InitializeOutlook() As Boolean
    On Error GoTo Init_Err
        If IsEmpty(olApp) Then
            Set olApp = CreateObject("Outlook.Application")
            Set olNameSpace = olApp.GetNamespace("MAPI")
            InitializeOutlook = True
        Else
            InitializeOutlook = True
        End If
    Exit_Init:
        Exit Function
    Init_Err:
        InitializeOutlook = False
        Resume Exit_Init
    End Function

    • Moved by Bill_Stewart Wednesday, October 31, 2012 7:50 PM Move to more appropriate forum (From:The Official Scripting Guys Forum!)
    Wednesday, October 31, 2012 6:38 PM

Answers

  • Hi Arama,

    Thanks for posting in the MSDN Forum.

    You need access the MAPIFolder of which named "Public Folders" via Application.Session.GetDefalutFolder(18) first.

    Have a good day,

    Tom


    Tom Xu [MSFT]
    MSDN Community Support | Feedback to us

    Wednesday, November 21, 2012 9:00 AM
    Moderator