Retrieve values from closed workbook

Hi Guys,

I have a code which extracts data from the closed workbook, but recently i have noticed that from some workbook it retrieves data as a text i have highlighted in red which is as text, but rest of the files work fine and recognised as a values.

Hopefully somebody would be so kind and help me to adjust the code to retrieve data as values.

Thanks in advance.

Functions module code

Option Explicit


Public Sub GetData(SourceFile As Variant, SourceSheet As String, _
                   SourceRange As String, TargetRange As Range, Header As Boolean, UseHeaderRow As Boolean)
' 30-Dec-2007, working in Excel 2000-2007
    Dim rsCon As Object
    Dim rsData As Object
    Dim szConnect As String
    Dim szSQL As String
    Dim lCount As Long

    ' Create the connection string.
    If Header = False Then
        If Val(Application.Version) < 12 Then
            szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 8.0;HDR=No"";"
        Else
            szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 12.0;HDR=No"";"
        End If
    Else
        If Val(Application.Version) < 12 Then
            szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 8.0;HDR=Yes"";"
        Else
            szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 12.0;HDR=Yes"";"
        End If
    End If

    If SourceSheet = "" Then
        ' workbook level name
        szSQL = "SELECT * FROM " & SourceRange$ & ";"
    Else
        ' worksheet level name or range
        szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "];"
    End If

    On Error GoTo SomethingWrong

    Set rsCon = CreateObject("ADODB.Connection")
    Set rsData = CreateObject("ADODB.Recordset")

    rsCon.Open szConnect
    rsData.Open szSQL, rsCon, 0, 1, 1

    ' Check to make sure we received data and copy the data
    If Not rsData.EOF Then

        If Header = False Then
            TargetRange.Cells(1, 1).CopyFromRecordset rsData
        Else
            'Add the header cell in each column if the last argument is True
            If UseHeaderRow Then
                For lCount = 0 To rsData.Fields.Count - 1
                    TargetRange.Cells(1, 1 + lCount).Value = _
                    rsData.Fields(lCount).Name
                Next lCount
                TargetRange.Cells(2, 1).CopyFromRecordset rsData
            Else
                TargetRange.Cells(1, 1).CopyFromRecordset rsData
            End If
        End If

    Else
        MsgBox "No records returned from : " & SourceFile, vbCritical
    End If

    ' Clean up our Recordset object.
    rsData.Close
    Set rsData = Nothing
    rsCon.Close
    Set rsCon = Nothing
    Exit Sub

SomethingWrong:
    MsgBox "The file name, Sheet name or Range is invalid of : " & SourceFile, _
           vbExclamation, "Error"
    On Error GoTo 0

End Sub

Code in module

Sub RoundedRectangle2_Click()

    Dim sFileName As String
    Dim sPathAndFileName As String
    Dim strPath As String

    strPath = "S:\CLUB ASSEMBLY QC\1. UK"
    sFileName = "QC DATA 2012 - 2020..xlsm"
    sPathAndFileName = strPath & "\" & sFileName
    If LjmIsFileOpen(sPathAndFileName) = True Then
      GoTo ERROR_EXIT
    Else
      GetData sPathAndFileName, "DataBase", "A2:X350000", Sheets("Data Support").Range("B3"), False, False
    End If
    
    strPath = "S:\CLUB ASSEMBLY QC\2. Incoming Inspection UK and Helmond"
    sFileName = "Incoming Inspection Warehouse UK 2013 -.xlsm"
    sPathAndFileName = strPath & "\" & sFileName
    If LjmIsFileOpen(sPathAndFileName) = True Then
      GoTo ERROR_EXIT
    Else
      GetData sPathAndFileName, "Data Collection", "D6:CA10000", Sheets("Data Support").Range("AD3"), False, False
    End If
    
    strPath = "S:\CLUB ASSEMBLY QC\1. UK"
    sFileName = "Incoming Inspection 2013 -.xlsm"
    sPathAndFileName = strPath & "\" & sFileName
    If LjmIsFileOpen(sPathAndFileName) = True Then
      GoTo ERROR_EXIT
    Else
      GetData sPathAndFileName, "Data Collection", "D6:BZ10000", Sheets("Data Support").Range("DC3"), False, False
    End If
    
    strPath = "S:\CLUB ASSEMBLY QC\1. UK"
    sFileName = "QC DATA 2012 - 2020 Ball Print Only..xlsm"
    sPathAndFileName = strPath & "\" & sFileName
    If LjmIsFileOpen(sPathAndFileName) = True Then
      GoTo ERROR_EXIT
    Else
      GetData sPathAndFileName, "Data Collection", "D5:S30000", Sheets("Data Support").Range("GA3"), False, False
    End If
    
    strPath = "S:\CLUB ASSEMBLY QC\1. UK"
    sFileName = "QC DATA 2012 - 2020 Cresting Only..xlsm"
    sPathAndFileName = strPath & "\" & sFileName
    If LjmIsFileOpen(sPathAndFileName) = True Then
      GoTo ERROR_EXIT
    Else
      GetData sPathAndFileName, "Data Collection", "A2:R30000", Sheets("Data Support").Range("GR3"), False, False
    End If
    
    strPath = "S:\CLUB ASSEMBLY QC\1. UK"
    sFileName = "Calibration Checks.xlsm"
    sPathAndFileName = strPath & "\" & sFileName
    If LjmIsFileOpen(sPathAndFileName) = True Then
      GoTo ERROR_EXIT
    Else
      GetData sPathAndFileName, "Calibration Checks", "B11:BZ2649", Sheets("Data Support").Range("HK3"), False, False
    End If
    
    strPath = "S:\Rick\QC\Issue Tracker"
    sFileName = "Issue tracker rev..xlsm"
    sPathAndFileName = strPath & "\" & sFileName
    If LjmIsFileOpen(sPathAndFileName) = True Then
      GoTo ERROR_EXIT
    Else
      GetData sPathAndFileName, "Sheet1", "B10:L1000", Sheets("Data Support").Range("KK3"), False, False
    End If
    
    strPath = "G:\Club Assembly Reports\# Weekly Figures"
    sFileName = "2014 Master Document.xlsm"
    sPathAndFileName = strPath & "\" & sFileName
    If LjmIsFileOpen(sPathAndFileName) = True Then
      GoTo ERROR_EXIT
    Else
      GetData sPathAndFileName, "Data Collection", "C35:DQ14998", Sheets("Data Support").Range("KW3"), False, False
    End If
    
     strPath = "S:\Rick\QC\Heads Bookings"
    sFileName = "Headsbookings.xlsm"
    sPathAndFileName = strPath & "\" & sFileName
    If LjmIsFileOpen(sPathAndFileName) = True Then
      GoTo ERROR_EXIT
    Else
      GetData sPathAndFileName, "DataBase", "A2:K14998", Sheets("Data Support").Range("PN3"), False, False
    End If
    Exit Sub
    
ERROR_EXIT:
    MsgBox "TERMINATING, because a data file cannot be opened EXCLUSIVELY." & vbCrLf & _
           "Folder: '" & strPath & "'" & vbCrLf & _
           "File Name: '" & sFileName & "'"
End Sub

Function LjmIsFileOpen(sPathAndFileName As String) As Boolean
  'This returns True if a file cannot be opened exclusively (i.e. is open(and probably locked) by another process)
  '
  'Possible errors:
  ' 70 - Permission Denied (i.e. File can't be opened exclusively - opened by another process)
  ' 76 - Folder and File combination does not exist
  
  Dim iFileNumber As Integer
  Dim iError As Integer

  On Error Resume Next       ' Turn error checking off.
  iFileNumber = FreeFile()   ' Get a free file number.
  
  'Attempt to open the file and lock it.
  Open sPathAndFileName For Input Lock Read As #iFileNumber
  Close iFileNumber          ' Close the file.
  iError = Err               ' Save the error number that occurred.
  On Error GoTo 0            ' Turn error checking back on.

  
  If iError = 0 Then
    LjmIsFileOpen = False
  Else
    LjmIsFileOpen = True
    'Debug.Print "LjmIsFileOpen() iError = " & iError
  End If
  
End Function