Outlook vba error

Question

I am not very experienced in Outlook VBA. I am using Outlook 2007 and i am trying to write a VBA code that will run when i receive any email. This code will read the subject line and save the email details in an excel file those are having the word "Update***" in subject. The code worked for the first time only, when i receive another email with the subject Update*** the code shows error 462. I check all the functions and pointed them to the objects. Then the code shows error 13 when running for the second time. I corrected the error 13 but now when i receive emails the VBA neither update the excel file nor shows any error message. My Outlook macro is enabled and I made sure that it isn't in design mode.

Code pasted in Outlook session :

    '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'

appExcel.Quit before you are saving? wkb.Save. In fact where are you saving the file and closing it? Resume ProgramExit will ensure that the saving doesn;t happen. — Siddharth Rout
remove the On Error GoTo ErrorHandler while developing. it will mask any errors you get, and you will not know why. — kurast

Siddharth Rout Siddharth Rout · Accepted Answer · 2014-05-21T12:41:30

Change your error handling to this

'
'~~> 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

Outlook vba error

1 Answers