Sub EE_ExtractColumnsFromFile(strSourceFile As String, strSrcSheet As String, rngHeadings As range, strTgtSheet As String, Optional blnDispMsg As Boolean = False)
    Dim rngTgt      As range
    Dim rngEach     As range
    Dim objConn     As Object
    Dim objRst      As Object
    Dim strSQL      As String
    Dim strFlds     As String
    Dim x           As Integer
 
'http://excelexperts.com/xla-routines-eeExtractColumnsFromFile    for updates on this sub routine

    Set objConn = CreateObject("Adodb.Connection")
    Set objRst = CreateObject("Adodb.Recordset")
 
    For Each rngEach In rngHeadings.Cells
        strFlds = strFlds & ",[" & rngEach.value & "]"
    Next rngEach
    strFlds = Mid(strFlds, 2)
 
    strSQL = "SELECT " & strFlds & " FROM [" & strSrcSheet & "$];"
 
    Set rngTgt = ThisWorkbook.Worksheets(strTgtSheet).range("A1")
    If rngTgt Is Nothing Then Exit Sub
    'Set objConn = New ADODB.Connection
    On Error Resume Next
    objConn.Open "DRIVER={Microsoft Excel Driver (*.xls)};DriverId=790;" & _
        "ReadOnly=True;DBQ=" & strSourceFile & ";"
    ' DriverId=790: Excel 97/2000
    ' DriverId=22:  Excel 5/95
    ' DriverId=278: Excel 4
    ' DriverId=534: Excel 3
    On Error GoTo 0
    If objConn Is Nothing Then
        If blnDispMsg = True Then
            MsgBox "Can't find the file!", vbExclamation, ThisWorkbook.Name
        End If
        Exit Sub
    End If
 
    ' open a recordset
    'Set objRst = New ADODB.Recordset
    On Error Resume Next
    objRst.Open strSQL, objConn, 0, 1, 1 'adOpenForwardOnly, adLockReadOnly, adCmdText
'    objRst.Open "SELECT * FROM [SheetName$]", _
        objConn, adOpenForwardOnly, adLockReadOnly, adCmdText
'    objRst.Open "SELECT * FROM [SheetName$]", _
        objConn, adOpenStatic, adLockOptimistic, adCmdText
'    objRst.Open "SELECT * FROM [SheetName$] WHERE [Field Name] LIKE 'A%'", _
        objConn, adOpenStatic, adLockOptimistic, adCmdText
'    objRst.Open "SELECT * FROM [SheetName$] WHERE [Field Name] LIKE 'A%' " & _
        "ORDER BY [Field Name]", objConn, adOpenStatic, adLockOptimistic, adCmdText

'    optional ways of retrieving a recordset
'    Set objRst = objConn.Execute("[A1:Z1000]") ' first worksheet
'    Set objRst = objConn.Execute("[DefinedRangeName]") ' any worksheet
    For x = 0 To objRst.Fields.Count - 1
        rngTgt.Offset(, x).value = objRst.Fields(x).Name
    Next x
 
    On Error GoTo 0
    If objRst Is Nothing Then
        'MsgBox "Can't open the file!", vbExclamation, ThisWorkbook.Name
        objConn.Close
        Set objConn = Nothing
        Exit Sub
    End If
 
    rngTgt.Offset(1).CopyFromRecordset objRst
 
    If objRst.State = 1 Then
        objRst.Close
    End If
 
    Set objRst = Nothing
    objConn.Close
    Set objConn = Nothing
    Set rngTgt = Nothing
    Set rngEach = Nothing
End Sub