VBA ADO 记录集

Question

我有这个记录集，它根据用户名从带有“PMWEB_BOA_Projects”的打开主表中选择数据，并将其数据从打开的主表中转移到“分配的项目 - 零售”表中。我的问题是，我的团队不想将他们的文件夹目录地址输入到我拥有的“rng”位置，以便 ADO 记录集知道在哪里查找工作簿。我如何绕过必须放置文件夹目录，而无需保存工作簿并且仍然只使用宏？

    Dim myfilespath As String
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim ws As Worksheet
    Dim ws2 As Worksheet
    Dim rng As String
    Dim LO As ListObject
    
    Set LO = Worksheets("Assigned projects - RETAIL").ListObjects("Assigned")
        
    LO.AutoFilter.ShowAllData
        

    Set cn = New ADODB.Connection
    Set ws2 = Workbooks("PMWEB_BOA_Projects.xlsm").Sheets("Instructions")
    rng = ws2.Range("F17").Value

    myfilepath = ThisWorkbook.Path

    myfilepath = ThisWorkbook.Path

    'This one is for V6 data tab
    cn.Mode = adModeRead

    cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=" & ActiveWorkbook.fullName & ";" & _
    "Extended Properties='Excel 12.0 Macro;HDR=YES;IMEX=1';"
    
    cn.Open

    Set rs = New ADODB.Recordset

    rs.ActiveConnection = cn
    rs.Source = SQLV6Retail

    rs.Open

    Set ws = Workbooks("PMWEB_BOA_Projects.xlsm").Sheets("Assigned Projects - RETAIL")

    ws.Activate
    ws.Range("A2").CopyFromRecordset rs

    rs.Close
    cn.Close

End Sub

Answer 1

尝试使用

"Data Source=" & ThisWorkbook.FullName

Option Explicit

Sub Macro1()

   Const SQLV6Retail = "SELECT * FROM [Sheet1$]" ' test
    
    Dim cn As ADODB.Connection, sConn As String
    Dim wb As Workbook, ws As Worksheet
    Dim LO As ListObject, n As Long
   
    Set wb = ThisWorkbook 'Workbooks("PMWEB_BOA_Projects.xlsm")
    Set ws = wb.Sheets("Assigned projects - RETAIL")
    Set LO = ws.ListObjects("Assigned")
    LO.AutoFilter.ShowAllData
        
    sConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
            "Data Source=" & ThisWorkbook.FullName & ";" & _
            "Extended Properties='Excel 12.0 Macro;HDR=YES;IMEX=1';"
    'Debug.Print sConn
    
    Set cn = New ADODB.Connection
    With cn
        .Mode = adModeRead 'This one is for V6 data tab
        .ConnectionString = sConn
        .Open
    End With
    
    ws.Range("A2").CopyFromRecordset cn.Execute(SQLV6Retail)
    cn.Close
    MsgBox "Done", vbInformation

End Sub