在ADO中使用命名范围，可以吗？

问题描述

我将ADO与下面的代码结合使用，以从关闭的文件中提取数据。

我工作得很好，但是我想知道是否有一种方法可以使用select语句中的命名范围代替Address。这样可以使宏更加动态。

是否有人知道在sourceRange的select语句中使用命名范围的方法（在目标文件和当前文件中，命名范围都可以使用，但高度或高度可以不同）。

 Sub getFromClosedFile
   Dim CN As Object,RS As Recordset

   sourceFile = Application.GetopenFilename("Excel Files (*.xls*),*xls*","Select QIP file","Select QIP",False)

   'GET RECORDSET FROM CLOSED FILE
   Set CN = ADO_OpenConnection(sourceFile,True)

   Set rngTarget = Sheets(sourceSheet).Range("A1") 'HERE I WOULD WANT TO USE A NAMED RANGE INSTEAD OF A1
   
   'GET RECORDSET
   Set RS = ADO_GetRecordsetFromOpenedConnection(CN,CStr(sourceSheet),sourceRange)

   ' copY RECORDSET TO SHEET
   ADO_copyRsToTargetRange RS,rngTarget,True,True ',Header,UseHeaderRow
        
   ' CLEAN UP VARIABLES - USE BYREF
   ADO_ClearRecordset RS
   ADO_ClearConnection CN
End sub

Public Function ADO_OpenConnection(sourceFilePath As String,_
                                    Optional Header As Boolean,Optional UseHeaderRow As Boolean) As Object
    
    Dim rsCon  As Object
    Dim sourceFileExtension As String,strProvider As String,strExcelVersion As String,strHdr As String,szConnect As String
    
    sourceFileExtension = Split(sourceFilePath,".")(UBound(Split(sourceFilePath,".")))
    
    'BY EXCEL VERSION
    If Val(Application.Version) < 12 Then
        strProvider = "Microsoft.Jet.OLEDB.4.0;"
        strExcelVersion = "Excel 8.0"
    Else
        strProvider = "Microsoft.ACE.OLEDB.12.0;"
        Select Case UCase(sourceFileExtension)
            Case "XLSM": strExcelVersion = "Excel 12.0 Macro"
            Case "XLSX": strExcelVersion = "Excel 12.0"
        End Select
    End If
    
    If Header = False Then
        strHdr = "HDR=NO"
    Else
        strHdr = "HDR=YES"
    End If
    
    szConnect = "Provider=" & strProvider & _
            "Data Source=" & sourceFilePath & ";" & _
            "Extended Properties=""" & strExcelVersion & ";" & strHdr & """;"
        
    'CREATE CONNECTION OBJECT
    Set rsCon = CreateObject("ADODB.Connection")
1:        rsCon.Open szConnect

    Set ADO_OpenConnection = rsCon
End Function

Public Function ADO_GetRecordsetFromOpenedConnection(rsCon As Object,sourceSheet As String,Optional sourceRange As String) As Recordset
    
    Dim szsql As String,rsData As Recordset
    
    'COMBINE sql STRING TO SELECT SPECIFIC SHEET/RANGE
    szsql = "Select * from [" & sourceSheet & "$" & sourceRange & "]"
    
    'CREATE CONNECTION OBJECTS
    Set rsData = CreateObject("ADODB.Recordset")
2:        rsData.Open szsql,rsCon,1,1

    Set ADO_GetRecordsetFromOpenedConnection = rsData
End Function

Sub ADO_copyRsToTargetRange(ByRef rsData As Recordset,ByRef TargetRange As Range,Optional Header As Boolean,Optional UseHeaderRow As Boolean)
    
    Dim lCount As Long,RS As Recordset
'https://www.devguru.com/content/technologies/ado/recordset-filter.html
    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
End Sub

Sub ADO_ClearConnection(ByRef rsCon As Object)
    rsCon.Close
    Set rsCon = nothing
End Sub

Sub ADO_ClearRecordset(ByRef rsData As Object)
    rsData.Close
    Set rsData = nothing
End Sub

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）

ado excel excel