如果我输入此代码而不将它们作为变量
,则此代码可以正常工作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
答案 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