Outlook vba錯誤

Question

我在Outlook VBA中不是很有經驗。我使用的是Outlook 2007，我正在嘗試編寫一個VBA代碼，該代碼在我收到任何電子郵件時運行。此代碼將讀取主題行並將電子郵件詳細信息保存在主題中包含「更新***」一詞的Excel文件中。該代碼僅適用於第一次，當我收到主題爲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