Question

我正在为Outlook安装一个VBA宏，我得到一个＆＃34;运行时错误＆＃39; 13＆＃39;：类型不匹配。我对VBA没有经验，所以我真的可以使用一些帮助。我试图将Outlook邮件主题和附件名称保存到文本文件。当它到达＆＃34; xlWB.close＆＃34;时，我收到错误13消息。

 Option Explicit
 Sub LogToExcel()
 Dim olItem As Outlook.MailItem
 Dim xlApp As Object
 Dim xlWB As Object
 Dim xlSheet As Object
 Dim vText, vText2, vText3, vText4, vText5 As Variant
 Dim rCount As Long
 Dim bXStarted As Boolean
 Dim enviro As String
 Dim strPath As String
 Dim mfolder As Folder
 Dim oAtt As Attachment
 Dim strAtt As String
 Dim strMail As String
 Dim selItems As Items

enviro = CStr(Environ("USERPROFILE"))
'the path of the workbook
 strPath = enviro & "\Desktop\outlook_log.xlsx"
     On Error Resume Next
     Set xlApp = GetObject(, "Excel.Application")
     If Err <> 0 Then
         Application.StatusBar = "Please wait while Excel source is opened ... "
         Set xlApp = CreateObject("Excel.Application")
         bXStarted = True
     End If
     On Error GoTo 0
     'Open the workbook to input the data
     Set xlWB = xlApp.Workbooks.Open(strPath)
     Set xlSheet = xlWB.Sheets("Sheet1")

Set mfolder = Application.ActiveExplorer.CurrentFolder

Set selItems = mfolder.Items

For Each olItem In selItems
strAtt = ""
strMail = ""
If olItem.Attachments.Count > 0 Then
For Each oAtt In olItem.Attachments
    strAtt = oAtt.FileName & "; " & strAtt
Next oAtt
Else
    strAtt = "No Attachments"
End If

    'Find the next empty line of the worksheet
     rCount = xlSheet.Range("B" & xlSheet.Rows.Count).End(-4162).Row
     rCount = rCount + 1

           vText = olItem.SenderName
           vText2 = olItem.ReceivedTime
           vText3 = olItem.Subject
           vText4 = strAtt
           vText5 = mfolder.Name

  xlSheet.Range("B" & rCount) = vText
  xlSheet.Range("c" & rCount) = vText2
  xlSheet.Range("d" & rCount) = vText3
  xlSheet.Range("e" & rCount) = vText4
  xlSheet.Range("f" & rCount) = vText5

Next

xlWB.Close
     If bXStarted Then
         xlApp.Quit
     End If
     Set xlApp = Nothing
     Set xlWB = Nothing
     Set xlSheet = Nothing
 End Sub

Answer 1

13是类型不匹配，这是因为olItem被定义为Outlook.MailItem，但mFolder.Items也可以包含其他内容（例如Outlook.MeetingItems）。快速更改代码可能是：

 Option Explicit
 Sub LogToExcel()
 Dim olItem As Outlook.MailItem
 Dim xlApp As Object
 Dim xlWB As Object
 Dim xlSheet As Object
 Dim vText, vText2, vText3, vText4, vText5 As Variant
 Dim rCount As Long
 Dim bXStarted As Boolean
 Dim enviro As String
 Dim strPath As String
 Dim mfolder As Folder
 Dim oAtt As Attachment
 Dim strAtt As String
 Dim strMail As String
 Dim selItems As Items

 Dim vItem


enviro = CStr(Environ("USERPROFILE"))
'the path of the workbook
 strPath = enviro & "\Desktop\outlook_log.xlsx"
     On Error Resume Next
     Set xlApp = GetObject(, "Excel.Application")
     If Err <> 0 Then
         Application.StatusBar = "Please wait while Excel source is opened ... "
         Set xlApp = CreateObject("Excel.Application")
         bXStarted = True
     End If
     On Error GoTo 0
     'Open the workbook to input the data
     Set xlWB = xlApp.Workbooks.Open(strPath)
     Set xlSheet = xlWB.Sheets("Sheet1")

Set mfolder = Application.ActiveExplorer.CurrentFolder

Set selItems = mfolder.Items

For Each vItem In selItems

If TypeOf vItem Is Outlook.MailItem Then
    Set olItem = vItem
    strAtt = ""
    strMail = ""
    If olItem.Attachments.Count > 0 Then
    For Each oAtt In olItem.Attachments
        strAtt = oAtt.FileName & "; " & strAtt
    Next oAtt
    Else
        strAtt = "No Attachments"
    End If

        'Find the next empty line of the worksheet
         rCount = xlSheet.Range("B" & xlSheet.Rows.Count).End(-4162).Row
         rCount = rCount + 1

               vText = olItem.SenderName
               vText2 = olItem.ReceivedTime
               vText3 = olItem.Subject
               vText4 = strAtt
               vText5 = mfolder.Name

      xlSheet.Range("B" & rCount) = vText
      xlSheet.Range("c" & rCount) = vText2
      xlSheet.Range("d" & rCount) = vText3
      xlSheet.Range("e" & rCount) = vText4
      xlSheet.Range("f" & rCount) = vText5
End If



Next vItem

xlWB.Close
     If bXStarted Then
         xlApp.Quit
     End If
     Set xlApp = Nothing
     Set xlWB = Nothing
     Set xlSheet = Nothing
 End Sub

VBA运行时错误＆＃39; 13＆＃39;

1 个答案: