I am trying to go through every file on the server and convert the old excel document to a new macro enabled one. This needs to be done in some way shape or form. It will convert hundreds of files then randomly stop with an open excel document left on my screen and the code stops without giving an error. This is more of a headache as I have to restart the conversion. Can someone tell me why this is happening. 


Sub ListFiles()

     
     'Declare the variables
     Dim objFSO As Scripting.FileSystemObject
     Dim objTopFolder As Scripting.Folder
     Dim strTopFolderName As String
     countYes = 0
     countNo = 0
     Dim temp As String
     
       Dim time1 As Double, time2 As Double
       Dim hour, min, sec As Double
       

    'Assign the top folder to a variable
     strTopFolderName = "H:\"

    Set startWork = Workbooks("CHANGE EXCEL.xlsm")
 
'  Call StartEmail

     
      time1 = Timer
     
     'Create an instance of the FileSystemObject
     Set objFSO = CreateObject("Scripting.FileSystemObject")
     
     'Get the top folder
     Set objTopFolder = objFSO.GetFolder(strTopFolderName)
     Range("A4").Select
     
     'Call the RecursiveFolder routine
     filePaths = strTopFolderName
     Application.DisplayAlerts = False
     Call RecursiveFolder(objTopFolder, True)
     

     
'     strTopFolderName = "L:\"
'
'
'  'Create an instance of the FileSystemObject
'     Set objFSO = CreateObject("Scripting.FileSystemObject")
'
'     'Get the top folder
'     Set objTopFolder = objFSO.GetFolder(strTopFolderName)
'     Range("A4").Select
'     'Call the RecursiveFolder routine
'    filePaths = filePaths + vbNewLine + strTopFolderName
'     Application.DisplayAlerts = False
'     Call RecursiveFolder(objTopFolder, True)
     
     
     Range("B1").Value = filePaths
     Range("B2").Value = countYes
     Range("B3").Value = countNo
     Range("B6") = "DONE"
      time2 = Timer
      
   hour = Application.WorksheetFunction.RoundDown(((time2 - time1) / 3600), 0)
min = Application.WorksheetFunction.RoundDown(((time2 - time1 - (hour * 3600)) / 60), 0)
sec = Application.WorksheetFunction.Round((((time2 - time1 - (60 * min) - (hour * 3600)))), 0)
Range("B4") = hour & "  HOURS  " & min & "  MINUTES  " & sec & "  SECONDS  "
Range("B5") = (time2 - time1) & " SECONDS"

   Application.DisplayAlerts = True
   
   Call Complete
   
End Sub

Sub RecursiveFolder(objFolder As Scripting.Folder, _
     IncludeSubFolders As Boolean)

     'Declare the variables
     Dim objFile As Scripting.File
     Dim tempString As String
     Dim objSubFolder As Scripting.Folder
     Dim NextRow As Long

     'Find the next available row
     NextRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
     
     'Loop through each file in the folder
     For Each objFile In objFolder.Files
     
            Workbooks("CHANGE EXCEL.XLSM").Activate
            Application.ScreenUpdating = True
            tempString = objFile
            Range("B6") = tempString

         Application.ScreenUpdating = False
   
         If UCase(Right(objFile, 3)) = "XLS" Then
            Application.EnableEvents = False
    
            Workbooks.Open Filename:=objFile
            ActiveWorkbook.SaveAs Filename:= _
            objFile & "m", FileFormat:= _
            xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
            ActiveWorkbook.Close
            Kill objFile
            Cells(countYes + 9, 1) = Now()
             Cells(countYes + 9, 2) = tempString
            countYes = countYes + 1
            Else
            countNo = countNo + 1
            End If
            Application.EnableEvents = True
            Application.ScreenUpdating = True
 
     Next objFile
     

'Loop through files in the subfolders
     If IncludeSubFolders Then
         For Each objSubFolder In objFolder.SubFolders
         filePaths = filePaths + vbNewLine + objSubFolder
             Call RecursiveFolder(objSubFolder, True)
         Next objSubFolder
     End If
     
     Exit Sub

     
End Sub