Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 931
  • Last Modified:

Access 2007, Outlook 2007, MAPI, Loop through items in .PickFolder

So, this code works fine to open the outlook picker and select a folder and iterate through the items in the collection and import them into a access table.  However, instead of using the picker, I would like to use the value from a form field where the user can store the text of the name of the folder in outlook.  I thought Set MyFolder = objNS.Folders(Me.OutlookFolderName) would work, but it does not.  Please help...

Dim OlApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim MyFolder As Outlook.MAPIFolder
Dim Mailobject As Object
Dim dealer As Integer

Dim rs As Recordset
Dim db As Database
Set db = CurrentDb
Set rs = db.OpenRecordset("tbl_outlooktemp")
Set OlApp = Outlook.Application
Set objNS = OlApp.GetNamespace("MAPI")
Set MyFolder = objNS.PickFolder
    For Each Mailobject In MyFolder.Items
    Me.OutlookFolderName = MyFolder
        With rs
                !Subject = Mailobject.Subject
                !From = Mailobject.SenderName
                !To = Mailobject.To
                !Body = Mailobject.Body
                !DateSent = Mailobject.SentOn
                !SenderEmailAddress = Mailobject.SenderEmailAddress
                !SenderEmailType = Mailobject.SenderEmailType
                !CC = Mailobject.CC
                !BCC = Mailobject.BCC
                !Importance = Mailobject.Importance
                !Sensitivity = Mailobject.Sensitivity
                !EntryID = Mailobject.EntryID
        End With

Set objNS = Nothing
Set MyFolder = Nothing
Set OlApp = Nothing
Set objNS = Nothing
1 Solution
Use this code from Sue Mosher's book (http://www.outlookcode.com)

Public Function GetFolder(strFolderPath As String) As MAPIFolder
  ' strFolderPath needs to be something like
  '   "Public Folders\All Public Folders\Company\Sales" or
  '   "Personal Folders\Inbox\My Folder"

  Dim objApp As Outlook.Application
  Dim objNS As Outlook.NameSpace
  Dim colFolders As Outlook.Folders
  Dim objFolder As Outlook.MAPIFolder
  Dim arrFolders() As String
  Dim I As Long
  On Error Resume Next

  strFolderPath = Replace(strFolderPath, "/", "\")
  arrFolders() = Split(strFolderPath, "\")
  Set objApp = Application
  Set objNS = objApp.GetNamespace("MAPI")
  Set objFolder = objNS.Folders.Item(arrFolders(0))
  If Not objFolder Is Nothing Then
    For I = 1 To UBound(arrFolders)
      Set colFolders = objFolder.Folders
      Set objFolder = Nothing
      Set objFolder = colFolders.Item(arrFolders(I))
      If objFolder Is Nothing Then
        Exit For
      End If
  End If

  Set GetFolder = objFolder
  Set colFolders = Nothing
  Set objNS = Nothing
  Set objApp = Nothing
End Function

Open in new window


Featured Post


Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now