Dear Gurus,

i have the following code which was working before and don't know what happen now my debugger stops at Set rep = itm

any help will be appreciated. thanks.

Code:
Sub ExportfromoutlooktoExcel()

  

'On Error GoTo ErrorHandler

  

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 i As Integer

Dim j As Integer

Dim lngCount As Long

Dim msg As Outlook.MailItem

Dim rep As Outlook.ReportItem

Dim nms As Outlook.NameSpace

Dim fld As Outlook.MAPIFolder

'Must declare as Object because folders may contain different

'types of items

Dim itm As Object

Dim strTitle As String

Dim strPrompt As String

Dim Proceed

  

Dim fYear, rYear, iMonth As Integer

Dim rMonth As String

  

  

Set appExcel = CreateObject("Excel.Application")

Workbooks.Add

Set wkb = appExcel.ActiveWorkbook

Set wks = wkb.Sheets(1)

wks.Activate

appExcel.Application.Visible = True

    Sheets("Sheet1").Select

    Sheets("Sheet1").Name = "Email"

   

 

'Adjust i (row number) to be 1 less than the number of the first body row

i = 1

j = 1

  

'Create Header Row

  

Set rng = wks.Cells(i, j)

rng.Value = "Subject"

j = j + 1

  

Set rng = wks.Cells(i, j)

rng.Value = "Body"

j = j + 1

  

Set rng = wks.Cells(i, j)

rng.Value = "FromName"

j = j + 1

  

Set rng = wks.Cells(i, j)

rng.Value = "ToName"

j = j + 1

  

Set rng = wks.Cells(i, j)

rng.Value = "Importance"

j = j + 1

  

Set rng = wks.Cells(i, j)

rng.Value = "Sensitivity"

  

Set rng = wks.Cells(i, j)

rng.Value = "Action Date"

  

Proceed = MsgBox("Export for Misc Test?", vbYesNo, "Misc Test?")

  

If Proceed = 7 Then

  

''Calculate the fiscal year

If Month(Date) = 12 Then

    fYear = Year(Date) + 1

Else

    fYear = Year(Date)

End If

  

'Calculate the report calendar year and report month

If Month(Date) = 1 Then

    rYear = Year(Date) - 1

    iMonth = 12

Else

    rYear = Year(Date)

    iMonth = Month(Date) - 1

End If

  

If iMonth < 10 Then

    rMonth = "0" & iMonth

Else

    rMonth = iMonth

End If

  

ActiveWorkbook.SaveAs "C:\Users\jamilm\Downloads\FY" & fYear & "\" & rMonth & "." & rYear, 51


Else

  

appExcel.DisplayAlerts = False

ActiveWorkbook.SaveAs "C:\Users\jamilm\Downloads\misc.xlsx"

appExcel.DisplayAlerts = True

  

End If

  

  

'Let user select a folder to export

Set nms = Application.GetNamespace("MAPI")

Set fld = nms.PickFolder

If fld Is Nothing Then

GoTo ErrorHandlerExit

End If

  

'Test whether selected folder contains mail messages

If fld.DefaultItemType <> olMailItem Then

MsgBox "Folder does not contain mail messages"

GoTo ErrorHandlerExit

End If

  

lngCount = fld.Items.Count

  

If lngCount = 0 Then

MsgBox "No messages to export"

GoTo ErrorHandlerExit

End If

  

 

 

'Iterate through items in the folder, and export a few fields

'from each item to a row in the worksheet

For Each itm In fld.Items

If itm.Class = olMail Then

  

Set msg = itm

'i is the row number

i = i + 1

'j is the column number

j = 1

  

Set rng = wks.Cells(i, j)

If msg.Subject <> "" Then rng.Value = msg.Subject

j = j + 1

  

Set rng = wks.Cells(i, j)

If msg.Body <> "" Then rng.Value = msg.Body

j = j + 1

  

Set rng = wks.Cells(i, j)

If msg.SenderName <> "" Then rng.Value = msg.SenderName

j = j + 1

  

Set rng = wks.Cells(i, j)

If msg.To <> "" Then rng.Value = msg.To

j = j + 1

  

Set rng = wks.Cells(i, j)

rng.Value = msg.Importance

j = j + 1

  

Set rng = wks.Cells(i, j)

rng.Value = msg.Sensitivity

  

Set rng = wks.Cells(i, j)

If msg.To <> "" Then rng.Value = msg.ReceivedTime

j = j + 1

  

Else

  

Set rep = itm

'i is the row number

i = i + 1

'j is the column number

j = 1

  

Set rng = wks.Cells(i, j)

If rep.Subject <> "" Then rng.Value = rep.Subject

j = j + 1

  

Set rng = wks.Cells(i, j)

If rep.Body <> "" Then rng.Value = rep.Body

j = j + 3

  

Set rng = wks.Cells(i, j)

rng.Value = msg.Importance

j = j + 1

  

Set rng = wks.Cells(i, j)

rng.Value = msg.Sensitivity

  

End If

Next itm

  

  

Range("B:B").Select

Selection.WrapText = False

  

ActiveWorkbook.Save

ActiveWorkbook.Close

appExcel.Quit

  

Set appExcel = Nothing

Set wkb = Nothing

Set wks = Nothing

Set rng = Nothing

Set msg = Nothing

Set rep = Nothing

Set nms = Nothing

Set fld = Nothing

Set itm = Nothing

  

ErrorHandlerExit:

Exit Sub

  

ErrorHandler:

If Err.Number = 429 Then

'Application object is not set by GetObject; use CreateObject instead

    If appExcel Is Nothing Then

        Set appExcel = CreateObject("Excel.Application")

        Resume Next

    End If

Else

MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description

  

Resume ErrorHandlerExit

End If

  

End Sub