【发布时间】：2016-11-23 04:29:27
【问题描述】：
我正在处理以下代码，并试图让它从 Outlook 中的两个不同文件夹添加电子邮件，但我显然遗漏了一些东西，因为它不起作用。发生的情况是，当我运行代码时，它会从“PolicyCenter”文件夹而不是“Apex”文件夹中提取所有电子邮件。我不确定我做错了什么，任何帮助或建议将不胜感激！
Option Explicit
Sub VBA_Export_Outlook_Emails_To_Excel()
Dim Folder As Outlook.MAPIFolder
Dim sFolders As Outlook.MAPIFolder
Dim iRow As Integer, oRow As Integer
Dim MailBoxName As String, Pst_Folder_Name As String
MailBoxName = "Mailbox, PL-SYSTEM-OUTAGES"
Pst_Folder_Name = "Apex"
Pst_Folder_Name = "PolicyCenter"
For Each Folder In Outlook.Session.Folders(MailBoxName).Folders
If VBA.UCase(Folder.Name) = VBA.UCase(Pst_Folder_Name) Then GoTo Label_Folder_Found
For Each sFolders In Folder.Folders
If VBA.UCase(sFolders.Name) = VBA.UCase(Pst_Folder_Name) Then
Set Folder = sFolders
GoTo Label_Folder_Found
End If
Next sFolders
Next Folder
Label_Folder_Found:
If Folder.Name = "" Then
MsgBox "Invalid Data in Input"
GoTo End_Lbl1:
End If
ThisWorkbook.Sheets(1).Activate
Folder.Items.Sort "Received"
ThisWorkbook.Sheets(1).Cells(1, 1) = "Sender"
ThisWorkbook.Sheets(1).Cells(1, 2) = "Subject"
ThisWorkbook.Sheets(1).Cells(1, 3) = "Date"
ThisWorkbook.Sheets(1).Cells(1, 4) = "Size"
'ThisWorkbook.Sheets(1).Cells(1, 5) = "EmailID"
'ThisWorkbook.Sheets(1).Cells(1, 6) = "Body"
oRow = 1
For iRow = 1 To Folder.Items.Count
If VBA.DateValue(VBA.Now) - VBA.DateValue(Folder.Items.Item(iRow).ReceivedTime) <= 60 Then
oRow = oRow + 1
ThisWorkbook.Sheets(1).Cells(oRow, 1).Select
ThisWorkbook.Sheets(1).Cells(oRow, 1) = Folder.Items.Item(iRow).SenderName
ThisWorkbook.Sheets(1).Cells(oRow, 2) = Folder.Items.Item(iRow).Subject
ThisWorkbook.Sheets(1).Cells(oRow, 3) = Folder.Items.Item(iRow).ReceivedTime
ThisWorkbook.Sheets(1).Cells(oRow, 4) = Folder.Items.Item(iRow).Size
'ThisWorkbook.Sheets(1).Cells(oRow, 5) = Folder.Items.Item(iRow).SenderEmailAddress
'ThisWorkbook.Sheets(1).Cells(oRow, 6) = Folder.Items.Item(iRow).Body
End If
Next iRow
MsgBox "Outlook Mails Extracted to Excel"
Set Folder = Nothing
Set sFolders = Nothing
End_Lbl1:
End Sub
谢谢！！ -D
【问题讨论】：
-
你设置
Pst_Folder_Name = "Apex"然后在下一行代码中用Pst_Folder_Name = "PolicyCenter"覆盖它。所以代码永远不会为“Apex”运行。 -
好的，有没有办法让它复制两个文件夹的内容？我在解决这个问题时遇到了一些问题。
-
将“新文件夹名称”放在两个下一条语句之间吗？ Next sFolders Pst_Folder_Name = "PolicyCenter" 下一个文件夹
-
@Deke 有几种方法可以在这两个文件夹上运行。 (a) 可能最简单：用
Pst_Folder_Name = "PolicyCenter"运行程序一次，然后用Pst_Folder_Name = "Apex"运行第二次； (b) 创建一个数组Dim FolderNames(1 to 2) as String，用 2 个文件夹名称填充数组，并将代码的“主力”部分放入For循环中； (c) 让你的宏接受一个参数Sub VBA_Export_Outlook_Emails_To_Excel(FolderName as String)然后从另一个子程序调用它两次 -
我实际上曾尝试设置一个宏，该宏将通过使用
Call Module1.VBA_Export_Outlook_Emails_To_Excel并从模块 1 到 19（我的所有报告）执行此操作，但问题是它们不断相互覆盖因为他们都从 A2 开始......如果我能得到它，那么他们就会在下一条可用的线路上运行，这将解决我的问题。知道如何让它发挥作用吗？