Pull email from specified folder instead of folderpicker

[coryjacques]

The below code allows me to select a folder from outlook and pull some information from it. I didn't create this code - someone way more intelligent did! What I'm having issues with is getting rid of the selector for folder; I want to specify a mail folder within the code that will never vary. I've tried a few things that don't seem to work... Any suggestions?

Sub GetMailInfo()
Dim results() As String
  ' get contacts
  results = ExportEmails(True)

  Range(Cells(1, 1), Cells(UBound(results), UBound(results, 2))).Value = results
    MsgBox "Completed"
End Sub
Function ExportEmails(Optional headerRow As Boolean = False) As String()
Dim objOutlook As Object ' Outlook.Application
Dim objNamespace As Object ' Outlook.Namespace
Dim strFolderName As Object
Dim objMailbox As Object
Dim objFolder As Object
Dim mailFolderItems As Object ' Outlook.items
Dim folderItem As Object
Dim msg As Object ' Outlook.MailItem
Dim tempString() As String
Dim i As Long
Dim numRows As Long
Dim startRow As Long
Dim jAttach As Long ' counter for attachments
Dim debugMsg As Integer
Sheets("OutlookResults").Select
Sheets("OutlookResults").Cells.ClearContents
Range("A1").Select
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set strFolderName = objNamespace.PickFolder
Set mailFolderItems = strFolderName.Items
  If headerRow Then
    startRow = 1
  Else
    startRow = 0
  End If
  numRows = mailFolderItems.Count
  ReDim tempString(1 To (numRows + startRow), 1 To 100)
  For i = 1 To numRows
    Set folderItem = mailFolderItems.Item(i)
    If IsMail(folderItem) Then
      Set msg = folderItem
    End If
    With msg
      tempString(i + startRow, 1) = .Subject
      tempString(i + startRow, 2) = .SenderName
      tempString(i + startRow, 3) = .SentOn
      tempString(i + startRow, 4) = .ReceivedTime
      tempString(i + startRow, 5) = .To
    End With
  Next i
  ' first row of array should be header values
  If headerRow Then
    tempString(1, 1) = "Subject"
    tempString(1, 2) = "SenderName"
    tempString(1, 3) = "SentOn"
    tempString(1, 4) = "Received Time"
    tempString(1, 5) = "To"
  End If
  ExportEmails = tempString

End Function
Function IsMail(itm As Object) As Boolean
  IsMail = (TypeName(itm) = "MailItem")
End Function

 

[John_w]

Does https://www.mrexcel.com/forum/excel...nt-mails-outlook-post5306340.html#post5306340 help?

 

[coryjacques]

I cant get it to work for mine... Any suggestions?

 

[John_w]

Add this after the PickFolder line in your original code:

MsgBox strFolderName.FolderPath

and tell me what is displayed in the message box when you run it.

For example, if "\\MyAccount\folder1\subfolder1" is displayed, replace the PickFolder line with:

    Set strFolderName = objNamespace.Folders("MyAccount").Folders("folder1").Folders("subfolder1")

 

[coryjacques]

This worked! Thank you so much!