Question

this code works fine if I type this in without having them as variables

Set objFolder = objNameSpace.Folders("pavle.stoj@blah.com").Folders("Inbox").Folders("test")

in my Excel Sheet I have them written in the cell to grab and add it.

my reason is because I want to give the excel doc to someone and not give them access to the code etc etc...

My Error Message tells me it cant find the folder to set as the object GRRRR...

I probably did something totally wrong ?

Option Explicit

Sub ExtractMyEmails()

' Created By Pavle Stojanovic 2014

Dim objOutlook As Object
Dim objNameSpace As Object
Dim EmailCount As Integer
Dim AllEmails As Outlook.Items
Dim sEmail As Outlook.MailItem
Dim EmailAddress As Variant
Dim x As Integer
Dim i As Integer
Dim objFolder As Object
Dim ErrMsg1 As Variant
Dim ErrMsg2 As Variant
Dim FolderToSearch As Variant
Dim Search As String

On Error Resume Next

 Set objOutlook = CreateObject("Outlook.Application")
 Set objNameSpace = objOutlook.GetNamespace("MAPI")

  EmailAddress = ("""" & Worksheets("Exported Emails").Cells(3, "A").Value & """")
  x = 2
  Search = ""

FolderToSearch = Split(Worksheets("Exported Emails").Cells(6, "A").Value, ";")

 For i = 0 To UBound(FolderToSearch)

  Search = Search & ".Folders(""" & FolderToSearch(i) & """)"

 Next

 Set objFolder = objNameSpace.Folders(EmailAddress) & Search

 Set AllEmails = objFolder.Items
     EmailCount = objFolder.Items.Count

  If Err.Number <> 0 Then
     Err.Clear
     ErrMsg1 = MsgBox("No such folder.", vbInformation, "Error - Inbox Folder not Found.")
     Exit Sub
  End If

  If EmailCount = 0 Then
     ErrMsg2 = MsgBox("No Emails", vbInformation, "Error - No Emails Found.")
     Exit Sub
  End If

 For Each sEmail In AllEmails

  Worksheets("Exported Emails").Cells(x, "C") = sEmail.To
  Worksheets("Exported Emails").Cells(x, "D") = sEmail.SenderName
  Worksheets("Exported Emails").Cells(x, "E") = sEmail.CC
  Worksheets("Exported Emails").Cells(x, "F") = sEmail.Subject
  Worksheets("Exported Emails").Cells(x, "G") = sEmail.ReceivedTime
  Worksheets("Exported Emails").Cells(x, "H") = SetBytes(sEmail.Size)

  x = x + 1

 Next

 Worksheets("Exported Emails").Cells(2, "J") = EmailCount

End Sub
Was it helpful?

Solution

What does the following line do?

Set objFolder = objNameSpace.Folders(EmailAddress) & Search

You are concatenating a sting (Search) with an object (VBA retrieves the default string property - Name) and you end up with a string.

Try something like the following (off the top of my head):

Set objFolder = objNameSpace.Folders(EmailAddress)
For i = 0 To UBound(FolderToSearch)
  set objFolder = objFolder.Folders.Item(FolderToSearch(i))
Next
Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top