VBA MACRO – 将电子邮件地址导出到Excel

我在这里有一个VBA代码，将所选子文件夹的电子邮件地址导出到Excel文件中。 我的问题是，它只适用于我的文件夹中的一个。

当我尝试使用此macros到其他文件夹时，出现“运行时错误13types不匹配”错误。 我真的不知道为什么我得到这个错误。 我希望有人能帮助我发现问题的来源。

这是我的代码：

Sub ExportToExcel() Dim appExcel As Excel.Application Dim wkb As Excel.Workbook Dim wks As Excel.Worksheet Dim rng As Excel.Range Dim strSheet As String Dim strPath As String Dim intRowCounter As Integer Dim intColumnCounter As Integer Dim msg As Outlook.MailItem Dim nms As Outlook.NameSpace Dim fld As Outlook.MAPIFolder Dim itm As Object strSheet = "OutlookItems.xlsx" strPath = "C:\Users\Gabriel.Alejandro\Desktop\" strSheet = strPath & strSheet Debug.Print strSheet 'Select export folder Set nms = Application.GetNamespace("MAPI") Set fld = nms.PickFolder 'Handle potential errors with Select Folder dialog box. 'Open and activate Excel workbook. Set appExcel = CreateObject("Excel.Application") appExcel.Workbooks.Open (strSheet) Set wkb = appExcel.ActiveWorkbook Set wks = wkb.Sheets(1) wks.Activate appExcel.Application.Visible = True 'Copy field items in mail folder. For Each itm In fld.Items intColumnCounter = 1 Set msg = itm 'The part where I am getting the ERROR intRowCounter = intRowCounter + 1 Set rng = wks.Cells(intRowCounter, intColumnCounter) rng.Value = msg.To intColumnCounter = intColumnCounter + 1 Set rng = wks.Cells(intRowCounter, intColumnCounter) rng.Value = msg.SenderEmailAddress Next itm Set appExcel = Nothing Set wkb = Nothing Set wks = Nothing Set rng = Nothing Set msg = Nothing Set nms = Nothing Set fld = Nothing Set itm = Nothing Exit Sub Set appExcel = Nothing Set wkb = Nothing Set wks = Nothing Set rng = Nothing Set msg = Nothing Set nms = Nothing Set fld = Nothing Set itm = Nothing End Sub 

Answer 1

你假设每一个itm都是一个邮件项目。

如果不是mailitem，您可以跳过一个项目：

 For Each itm In fld.items intColumnCounter = 1 If itm.Class = olMail Then Set msg = itm intRowCounter = intRowCounter + 1 Set rng = wks.Cells(intRowCounter, intColumnCounter) rng.Value = msg.To intColumnCounter = intColumnCounter + 1 Set rng = wks.Cells(intRowCounter, intColumnCounter) rng.Value = msg.senderemailaddress Else Debug.Print " Item is not a mailitem." End If Next itm 

如果项目没有你想要的属性，你可以绕过错误。

 For Each itm In fld.items intColumnCounter = 1 intRowCounter = intRowCounter + 1 Set rng = wks.Cells(intRowCounter, intColumnCounter) On Error Resume Next rng.Value = itm.To On Error GoTo 0 intColumnCounter = intColumnCounter + 1 Set rng = wks.Cells(intRowCounter, intColumnCounter) On Error Resume Next rng.Value = itm.senderemailaddress On Error GoTo 0 Next itm