How to retrieve data from other Excel using VBA and SQL?

ADOdb to Retrieve Data From Another Workbook (Without Opening It)

• While playing around with Parfait's solution combined with a few posts, I came up with the function copySheetADOdb.
• Adjust the constants under Source and Target in testCopySheetADOdb to test it.

The Code

Option Explicit

Sub testCopySheetADOdb()
    
    ' Initialize error handling.
    Const ProcName = "testCopySheetADOdb"
    On Error GoTo clearError ' Turn on error trapping.
    
    ' Source
    Const Path As String = "F:\Test"
    Const FileName As String = "Test.xlsx"
    ' Sheet Name ('SheetName') is case-insensitive i.e. 'A = a'.
    Const SheetName As String = "Sheet1"
    
    ' Target
    Const tgtName As String = "Sheet1"
    Const tgtCell As String = "A1"
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    ' Define FilePath.
    Dim FilePath As String
    FilePath = Path & Application.PathSeparator & FileName
    
    ' Define Target Range.
    Dim rng As Range
    Set rng = wb.Worksheets(tgtName).Range(tgtCell)
    
    ' Test Result.
    Dim Result As Boolean
    Result = copySheetADODb(rng, FilePath, SheetName)
    
    ' Of course you can do all the above in one line:
    'Result = copySheetADODB(Thisworkbook.Worksheets("Sheet1").Range("A1"), _
                            "C:\Test\Test.xlsx", "Sheet1")
    
    ' Inform user.
    If Result Then
        MsgBox "Worksheet successfully copied.", vbInformation, "Success"
    Else
        MsgBox "Worksheet not copied.", vbExclamation, "Failure"
    End If
        
ProcExit:
    Exit Sub

clearError:
    Debug.Print "'" & ProcName & "':" & vbLf & "    " & "Run-time error '" _
              & Err.Number & "':" & vbLf & "        " & Err.Description
    On Error GoTo 0 ' Turn off error trapping.
    GoTo ProcExit

End Sub

Function copySheetADOdb(TargetCellRange As Range, _
                        ByVal SourceFilePath As String, _
                        Optional ByVal SourceSheetName As String = "Sheet1") _
         As Boolean
    
    ' Initialize error handling.
    Const ProcName = "copySheetADOdb"
    On Error GoTo clearError ' Turn on error trapping.
    
    ' Test Target Cell Range ('TargetCellRange').
    If TargetCellRange Is Nothing Then
        GoTo NoTargetCellRange
    End If
    If TargetCellRange.Rows.Count > 1 Or TargetCellRange.Columns.Count > 1 Then
        GoTo OneCellOnly
    End If
'
    ' Define SQL Generic String.
    Const sqlGeneric As String = "SELECT * FROM [SheetName$]"
    
    Dim conn As Object
    Set conn = CreateObject("ADODB.Connection")
    Dim strErr As String
    With conn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        ' If you need the headers, HDR=NO means there are no headers
        ' (not: do not retrieve headers) so the complete data will be retrieved.
        .ConnectionString = "Data Source='" _
                          & SourceFilePath _
                          & "';" _
                          & "Extended Properties='" _
                          & "Excel 12.0 Xml;" _
                          & "HDR=NO;" _
                          & "IMEX=1;" _
                          & "CorruptLoad=xlRepairFile" _
                          & "';"
        On Error GoTo connOpenError
        .Open
            On Error GoTo clearError
            ' Run SQL.
            Dim SQL As String
            ' Replace 'SheetName' in SQL Generic String
            ' with the actual sheet name ('SourceSheetName').
            SQL = Replace(sqlGeneric, "SheetName", SourceSheetName)
            Dim rs As Object
            On Error GoTo connExecuteError
            Set rs = .Execute(SQL)
            On Error GoTo clearError
            If Not TargetCellRange Is Nothing Then
                ' Copy sheet.
                If Not rs.EOF Then
                    TargetCellRange.CopyFromRecordset rs
                    ' Write result.
                    copySheetADOdb = True
                Else
                    GoTo NoRecords
                End If
            End If
NoRecordsExit:
            rs.Close
connExecuteExit:
        .Close
    End With
    
ProcExit:
    Set rs = Nothing
    
connOpenExit:
    Set conn = Nothing

    Exit Function

NoTargetCellRange:
    Debug.Print "'" & ProcName & "': " & "No Target Cell Range ('Nothing')."
    GoTo ProcExit
    
OneCellOnly:
    Debug.Print "'" & ProcName & "': " _
              & "Target Cell Range has to be one cell range only."
    GoTo ProcExit

NoRecords:
    Debug.Print "'" & ProcName & "': No records found."
    GoTo NoRecordsExit

connOpenError:
    If Err.Number = "-2147467259" Then ' "-2147467259 (80004005)"
        strErr = "'" & SourceFilePath & "' is not a valid path"
        If Left(Err.Description, Len(strErr)) = strErr Then
            Debug.Print "'" & ProcName & "': " & strErr & "..."
            On Error GoTo 0 ' Turn off error trapping.
            GoTo connOpenExit
        End If
    Else
        GoTo clearError
    End If

connExecuteError:
    If Err.Number = "-2147467259" Then ' "-2147467259 (80004005)"
        strErr = "'" & SourceSheetName & "' is not a valid name"
        If Left(Err.Description, Len(strErr)) = strErr Then
            Debug.Print "'" & ProcName & "': " & strErr & "..."
            On Error GoTo 0 ' Turn off error trapping.
            GoTo connExecuteExit
        End If
    Else
        GoTo clearError
    End If

clearError:
    Debug.Print "'" & ProcName & "':" & vbLf & "    " & "Run-time error '" _
              & Err.Number & "':" & vbLf & "        " & Err.Description
    On Error GoTo 0 ' Turn off error trapping.
    GoTo ProcExit

End Function

You have problem in this code:

ThisWorkbook.Worksheets("Dic").Range("A1").Value = output

you are yourself asking to save the output to A1 Cell.

I would suggest you use for or while loop to enter the data in cells according to your need.