在Outlook中使用变量设置NameSpace不会工作但如果键入它可以工作

时间:2014-05-01 05:57:53

标签: excel-vba outlook-vba vba excel

如果我输入此代码而不将它们作为变量

,则此代码可以正常工作
Set objFolder = objNameSpace.Folders("pavle.stoj@blah.com").Folders("Inbox").Folders("test")

在我的Excel表格中,我将它们写在单元格中以抓取并添加它。

我的理由是因为我想将excel doc提供给某人而不是让他们访问代码等等...

我的错误消息告诉我它无法找到要设置为GRRRR对象的文件夹...

我可能做错了什么?

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

1 个答案:

答案 0 :(得分:0)

以下一行有什么作用?

Set objFolder = objNameSpace.Folders(EmailAddress) & Search

您正在将一个sting(Search)与一个对象连接起来(VBA检索默认的字符串属性 - Name),最后得到一个字符串。

尝试以下内容(在我的头顶):

Set objFolder = objNameSpace.Folders(EmailAddress)
For i = 0 To UBound(FolderToSearch)
  set objFolder = objFolder.Folders.Item(FolderToSearch(i))
Next