总之要导出电子邮件到包括附件的文件夹？
我有一个系统，我创build了超时，把电子邮件数据放到Excel电子表格上。 这是伟大的，但我也想在这个运行后，将包括从Outlook的任何附件的电子邮件提取到我的Windows PC上的一个新的文件夹。
当电子邮件在Excel电子表格上，然后电子邮件和附件被提取到我的电脑上的一个文件夹，我想要一个唯一的ID（可能是电子邮件的date，或只是一个随机数）被添加到电子邮件然后会自动发送一个链接地址到电子表格旁边的电子表格中，并将该唯一ID添加到电子表格中。 听起来有点混乱，我希望这是有道理的（这是可能的吗？）
人们会回复电子邮件，我也想回复原来的电子邮件（应该有上面列出的唯一ID）使用相同的ID它给了原来的电子邮件。 再次抱歉，如果这听起来令人困惑，如果需要，很乐意进入更多的细节。
这种东西是这样的，所以任何帮助将是伟大的。
这是我迄今写的代码;
Sub Download_Outlook_Mail_To_Excel() 'Add Tools->References->"Microsoft Outlook nn.n Object Library" 'nn.n varies as per our Outlook Installation 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 'Mailbox or PST Main Folder Name (As how it is displayed in your Outlook Session) MailBoxName = "neo_segauk@hotmail.com" 'Mailbox Folder or PST Folder Name (As how it is displayed in your Outlook Session) Pst_Folder_Name = "Inbox" 'Sample "Inbox" or "Sent Items" 'To directly a Folder at a high level 'Set Folder = Outlook.Session.Folders(MailBoxName).Folders(Pst_Folder_Name) 'To access a main folder or a subfolder (level-1) 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 'Read Through each Mail and export the details to Excel for Email Archival ThisWorkbook.Sheets(1).Activate Folder.Items.Sort "Received" 'Insert Column Headers 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" 'Export eMail Data from PST Folder oRow = 1 For iRow = 1 To Folder.Items.Count 'If condition to import mails received in last 60 days 'To import all emails, comment or remove this IF condition '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 而不是你的for循环，你可以这样做：
Dim msg As Outlook.MailItem ... For Each msg in Folder.Items 'You can access here each message properties, like msg.attachments... ThisWorkbook.Sheets(1).Cells(oRow, 1) = msg.Attachments.Item(1).FileName ... msg.Attachments.Item(1).SaveAsFile "C:\...." Next