将Outlook电子邮件中的电子邮件导出到Excel中。编码问题

问题描述：

我正在处理以下代码，并试图从Outlook中的两个不同文件夹中添加电子邮件，但我明显错过了某些内容，因为它不起作用。当我运行代码时，它会从“PolicyCenter”文件夹中取出所有电子邮件，而不是“Apex”文件夹。我不确定我在做什么错误，任何帮助或建议将不胜感激！将Outlook电子邮件中的电子邮件导出到Excel中。编码问题

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 =“顶点”'然后在下一行代码用'Pst_Folder_Name =“策略中心”'覆盖它。所以代码从未运行“Apex”。 – xidgel

好吧，有没有办法得到它，所以它会复制这两个文件夹的内容？我正在解决一些问题。 – Deke

会在两个下一个语句之间放置“新文件夹名称”吗？下一个sFolders Pst_Folder_Name =“PolicyCenter”下一个文件夹 –

答

会把两个下一个语句之间的“新文件夹名称”吗？

Next sFolders 
Pst_Folder_Name = "PolicyCenter" 
Next Folder

这样做是为了显示我的意思......

所以你的意思是在下面的'Pst_Folder_Name =“Apex”为Outlook.Session.Folders（MailBoxName）.Folders如果VBA.UCase（Folder.Name）= VBA.UCase（Pst_Folder_Name）然后GoTo Label_Folder_Found sFolders在Folder.Folders如果VBA.UCase（sFolders.Name）= VBA.UCase（Pst_Folder_Name）然后设置Folder = sFolders GoTo Label_Folder_Found结束如果下一个sFolders下一个文件夹Pst_Folder_Name =“PolicyCenter”下一个sFolders下一个文件夹'（对不起让这个显示正确）但是放在这里似乎并不奏效。仍然只进口一个文件夹电子邮件 – Deke

我的意思是在下一个文件夹之后，但在下一个文件夹之前 –

也尝试过。似乎没有工作。似乎无法弄清楚如何从多个文件夹中获取此信息，无论我做什么。任何其他的想法？在过去的两天里，我一直在想所有我能想到的事情（限于我知道哪些不是很多）。我的眼睛会掉出我的头。我只需要把它从多个邮箱中取出所有电子邮件，或者运行我现有的所有模块（每个模块设置为从一个特定的方框中取出电子邮件），然后在下一行可以输入的表格中输入，而无需彼此重叠。我非常感谢迄今为止的帮助。 – Deke

将Outlook电子邮件中的电子邮件导出到Excel中。编码问题

相关推荐