VBA always crash on Excel 2010 - excel

Question

I have some code that I make using Excel 2013. It works perfectly and when I try to run it on Excel 2010, the excel always does not respond, restarting the program and closing. I try to reopen it and the file sometimes goes with read-only or recovery mode so I can't even run my macro even I enable it.
Is there any way to fix this without updating the excel? any ideas?
NB: the laptop with Excel 2010 is not mine, it's my user laptop so if possible, I prefer to not change anything inside the laptop
here's the code
Public Const paramFolderPath = "C:\Users\Documents\Data"
Sub Sheet1()
Application.ScreenUpdating = False
OpenWorkbooks paramFolderPath 'Path collected from the folder parameter
Application.ScreenUpdating = True
End Sub
Sub OpenWorkbooks(sourceFolder As Variant)
Dim sourceFile As String 'Filename obtained by DIR function
Dim masterWb, Sourcewb As Workbook 'Used to loop through each workbook
Dim ext As String
On Error Resume Next
Application.ScreenUpdating = False
Set masterWb = ThisWorkbook
sourceFile = Dir(sourceFolder & "\") 'DIR gets the first file of the folder
Do While sourceFile <> ""
ext = Right(sourceFile, Len(sourceFile) - InStrRev(sourceFile, "."))
If sourceFile <> ThisWorkbook.Name And (ext = "xlsm" Or ext = "xlsx") Then
Workbooks.Open Filename:=sourceFolder & "\" & sourceFile, ReadOnly:=True
Set Sourcewb = ActiveWorkbook
'Copy only the first sheet of a workbook
Sourcewb.Worksheets(1).Copy after:=masterWb.Sheets(masterWb.Worksheets.Count)
'Close the source workbook
Sourcewb.Close SaveChanges:=False
Set Sourcewb = Nothing
End If
sourceFile = Dir 'DIR gets the next file in the folder
Loop
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Answer 1

Loop Through Files in a Folder
Option Explicit
Public Const paramFolderPath = "C:\Users\Documents\Data"
Sub GetFirstWorkSheets()
ImportFirstWorksheets paramFolderPath
End Sub
Sub ImportFirstWorksheets(ByVal sFolderPath As String)
Const ProcName As String = "ImportFirstWorksheets"
Dim fCount As Long
Dim wbCount As Long
Dim wsCount As Long
On Error GoTo ClearError
Const ExtensionsList As String = "xlsm,xlsx"
' Check if files in folder.
If Right(sFolderPath, 1) <> "\" Then sFolderPath = sFolderPath & "\"
Dim sFileName As String: sFileName = Dir(sFolderPath)
If Len(sFileName) = 0 Then
MsgBox "No files found in '" & sFolderPath & "'.", _
vbExclamation, ProcName
Exit Sub
End If
Dim Extensions() As String: Extensions = Split(ExtensionsList, ",")
Dim dwb As Workbook: Set dwb = ThisWorkbook
Dim dwbPath As String: dwbPath = dwb.FullName
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim swb As Workbook
Dim Ext As String
Dim sFilePath As String
Do While Len(sFileName) > 0
fCount = fCount + 1
Ext = Right(sFileName, Len(sFileName) - InStrRev(sFileName, "."))
If IsNumeric(Application.Match(Ext, Extensions, 0)) Then
wbCount = wbCount + 1
sFilePath = sFolderPath & sFileName
If StrComp(sFilePath, dwbPath, vbTextCompare) <> 0 Then
Application.DisplayAlerts = False
On Error GoTo WbError
Set swb = Workbooks.Open(sFilePath, , True)
On Error GoTo ClearError
Application.DisplayAlerts = True
End If
If Not swb Is Nothing Then
If swb.Worksheets.Count > 0 Then ' only first worksheet
wsCount = wsCount + 1
swb.Worksheets(1).Copy After:=dwb.Sheets(dwb.Sheets.Count)
End If
swb.Close SaveChanges:=False
Set swb = Nothing
End If
End If
sFileName = Dir ' next file in folder
Loop
SafeExit:
On Error Resume Next
If Not Application.EnableEvents Then
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
MsgBox "Files Found: " & fCount & vbLf _
& "Workbooks Found: " & wbCount & vbLf _
& "Worksheets Copied: " & wsCount, vbInformation, ProcName
On Error GoTo 0
Exit Sub
WbError:
Debug.Print "'" & ProcName & "' Run-time error '" _
& Err.Number & "':" & vbLf & " " & Err.Description
Resume Next
ClearError:
Debug.Print "'" & ProcName & "' Run-time error '" _
& Err.Number & "':" & vbLf & " " & Err.Description
Resume SafeExit
End Sub