Outlook vba 错误

Question

我在 Outlook VBA 方面不是很有经验。我正在使用 Outlook 2007，并且我正在尝试编写一个 VBA 代码，该代码将在我收到任何电子邮件时运行。此代码将读取主题行并将电子邮件详细信息保存在 Excel 文件中，这些文件的主题中包含“Update***”一词。该代码仅第一次工作，当我收到另一封主题为 Update*** 的电子邮件时，代码显示错误 462。我检查了所有功能并将它们指向对象。然后代码在第二次运行时显示错误13。我更正了错误 13，但现在当我收到电子邮件时，VBA 既不更新 excel 文件也不显示任何错误消息。我的 Outlook 宏已启用，并且我确保它未处于设计模式。

在 Outlook 会话中粘贴的代码：

    'Option Explicit

    Private WithEvents myOlItems  As Outlook.Items


Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
  Set olApp = Outlook.Application
  Set objNS = olApp.GetNamespace("MAPI")
  Set myOlItems = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub myOlItems_ItemAdd(ByVal Item As Object)

On Error GoTo ErrorHandler

Dim Msg As Outlook.MailItem
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


strSheet = "AppData.xls"
strPath = "C:\Email\"
strSheet = strPath & strSheet

If TypeName(Item) = "MailItem" Then
Set Msg = Item
If InStr(Msg.Subject, "Update***") <> 0 Then

Set appExcel = CreateObject("Excel.Application")
appExcel.Workbooks.Open (strSheet)
Set wkb = appExcel.ActiveWorkbook
Set wks = wkb.Sheets(1)
wks.Activate

intRowCounter = CInt(wks.Cells.Find("*", wks.Range("A1"), , , xlByRows,     xlPrevious).Row) 'substitute of this line of code :intRowCounter = wks.UsedRange.Rows.Count


appExcel.Application.Visible = True



intColumnCounter = 1
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





End If
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
appExcel.Quit


wkb.Save
appExcel.Quit
Set appExcel = Nothing
Set wkb = Nothing
Set wks = Nothing
Set rng = Nothing
Set Msg = Nothing
Set Item = Nothing


End Sub'

Answer 1

将您的错误处理更改为此

'
'~~> Rest of the code
'

wkb.Save

End If
End If

ProgramExit:
    On Error Resume Next
    wkb.Close (False)

    appExcel.Quit

    Set Rng = Nothing
    Set wks = Nothing
    Set wkb = Nothing
    Set appExcel = Nothing
    On Error GoTo 0

    Set Msg = Nothing
    Set Item = Nothing

    Exit Sub
ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ProgramExit