2014-09-05 63 views
0

我以前從來沒有玩過VBA。以下腳本應將Outlook電子郵件中的所有電子郵件詳細信息保存到Excel電子表格中。類型不匹配Outlook.MAPIFolder和對象(錯誤13)

我在執行Set msg = itm時收到錯誤13。在休息時間itm的值對應於會議邀請,所以不是您的普通電子郵件。這可能是問題嗎?如果是這樣,我如何告訴VBA忽略任何不是普通電子郵件的內容?

Sub ExportToExcel() 
On Error GoTo ErrHandler 
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.xls" 
    strPath = Environ("UserProfile") 
    strSheet = strPath & "\Downloads\" & strSheet 
Debug.Print strSheet 
    'Select export folder 
Set nms = Application.GetNamespace("MAPI") 
Set fld = nms.PickFolder 
    'Handle potential errors with Select Folder dialog box. 
If fld Is Nothing Then 
    MsgBox "There are no mail messages to export", vbOKOnly, _ 
    "Error" 
    Exit Sub 
ElseIf fld.DefaultItemType <> olMailItem Then 
    MsgBox "There are no mail messages to export", vbOKOnly, _ 
    "Error" 
    Exit Sub 
ElseIf fld.Items.Count = 0 Then 
    MsgBox "There are no mail messages to export", vbOKOnly, _ 
    "Error" 
    Exit Sub 
End If 
    '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 
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 
intColumnCounter = intColumnCounter + 1 
Set rng = wks.Cells(intRowCounter, intColumnCounter) 
rng.Value = msg.Subject 
intColumnCounter = intColumnCounter + 1 
Set rng = wks.Cells(intRowCounter, intColumnCounter) 
rng.Value = msg.SentOn 
intColumnCounter = intColumnCounter + 1 
Set rng = wks.Cells(intRowCounter, intColumnCounter) 
rng.Value = msg.ReceivedTime 
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 

ErrHandler: If Err.Number = 1004 Then 
    MsgBox strSheet & " doesn't exist", vbOKOnly, _ 
    "Error" 
    ElseIf Err.Number = 13 Then 
    MsgBox Err.Number & ": Type mismatch", vbOKOnly, _ 
    "Error" 
    Else 
    MsgBox Err.Number & "; Description: ", vbOKOnly, _ 
    "Error" 
End If 

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 

回答

1

如果你只想處理MailItem對象,檢查類屬性 - 所有Outlook對象模型對象實現它。對於MailItem物體,將爲olMail(= 43):

If itm.Class = 43 Then 'olMail 
    Set msg = itm 
    ...