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

问题描述：

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

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

这里是我的代码：

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

您定位的是哪个版本的Outlook/Office？ [Outlook.Folder和Outlok.MAPIFolder之间的区别]（http://stackoverflow.com/a/12353494/205233）似乎表示不推荐使用“Outlook.Namespace”和“Outlook.MAPIFolder”。 – Filburt

我正在尝试导出到Office 2013.此代码适用于Outlook中的其中一个子文件夹，但不适用于其他文件夹 – alejandraux

命名空间和MAPIFolder仅用于选择要导出的文件夹。我不认为这是问题 – alejandraux

答

您将承担所有的ITM是的MailItem。

，如果它不是你的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

我会尝试这一个，如果它有效，给你一个更新。这次真是万分感谢。 – alejandraux

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

相关推荐