VBA code not running the 2nd time

[Jacki]

Hi Folks,

I am having some issues with the below code. I think it has to do with object reference, but I am not sure how to fix it. Really appreciate any help!

Sub ExportToExcel(strFilename As String, strFolderPath As String)
Dim olkMsg As Object
Dim olkFld As Object
Dim excApp As Object
Dim excWkb As Object
Dim excWks As Object
Dim intRow As Integer
Dim intVersion As Integer

If strFilename <> "" Then
  If strFolderPath <> "" Then
    Set olkFld = OpenOutlookFolder(strFolderPath)
    If TypeName(olkFld) <> "Nothing" Then
      intVersion = GetOutlookVersion()
      Set excApp = CreateObject("Excel.Application")
      Set excWkb = excApp.Workbooks.Add()
      Set excWks = excWkb.ActiveSheet

      'Write Excel Column Headers
      With excWks
        .Cells(1, 1) = "Subject"
        .Cells(1, 2) = "Message"
        .Cells(1, 3) = "Received"
        .Cells(1, 4) = "Sender"
      End With

      intRow = 2
      For Each olkMsg In olkFld.Items
        If olkMsg.UnRead = True Then
          'Only export messages, not receipts or appointment requests, etc.
          If olkMsg.Class = olMail Then
            'Add a row for each field in the message you want to export
            excWks.Cells(intRow, 1) = olkMsg.Subject
            excWks.Cells(intRow, 2) = olkMsg.Body
            excWks.Cells(intRow, 3) = olkMsg.ReceivedTime
            excWks.Cells(intRow, 4) = GetSMTPAddress(olkMsg, intVersion)
            intRow = intRow + 1
            Range("A1:D1000").WrapText = True
          End If
        End If
      Next
      Set olkMsg = Nothing
      excWkb.SaveAs strFilename
      excWkb.Close
      Else
        MsgBox "The folder '" & strFolderPath & "' does not exist in Outlook.", vbCritical + vbOKOnly, MACRO_NAME
      End If
    Else
      MsgBox "The folder path was empty.", vbCritical + vbOKOnly, MACRO_NAME
    End If
  Else
    MsgBox "The filename was empty.", vbCritical + vbOKOnly, MACRO_NAME
End If
 
Set olkMsg = Nothing
Set olkFld = Nothing
Set excWks = Nothing
Set excWkb = Nothing
Set excApp = Nothing
Call Macro2
End Sub

 

[Jacki]

Sorry, I forgot to mention what the problem is. When I first open outlook the macro runs fine. If I need to run the macro again it doesn't run. I don't get any error message.. it just doesn't run. I can fix it by closing and re-opening outlook, but that is not ideal.