VBA ADO 记录集_编辑以包含所有代码

Question

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

Sub GetQueryResults2(SQLV6Retail As String)

'===============================
'This is for V6 data tab bringing data from retail workbook report

    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


'This one is for V6 data tab
cn.Mode = adModeRead
cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=" & rng & "\PMWEB_BOA_Projects.xlsm;" & _
    "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

Private Sub filterboa_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    Dim SQLV6Retail As String
    Dim BOARetail As String
    Dim wb1 As Workbook
    Dim SQLV6CORP As String
    
    'Worksheets("Assigned Projects").unprotect Password:="joshy"
    'save to network drive
     'ActiveWorkbook.SaveAs _
'Filename:=rng & "PMWEB_BOA_Projects"

    Set wb1 = ThisWorkbook
    With wb1.Sheets("Assigned projects - CORP")
    
    Last_row = .Range("A" & .Rows.Count).End(xlUp).Row
    
    End With

    'Call copyassignedprojects
    
    wb1.Sheets("Assigned projects - Retail").Activate
    wb1.Sheets("Assigned projects - Retail").Range("A2:AK2" & Last_row).Select
    Selection.ClearContents

    BOARetail = ListBox1.Value
    
    SQLV6Retail = "Select [Project Number], [Project Name], [Status], [15_Actual], [Project Manager], [Project Coordinator or BOA], [JPMC Budget], [JPMC Commitments], [JPMC Actuals], [SP Budget], " & _
    "[SP Commitments], [SP Actuals], [Total Budget], [Total Commitments], [Total Actuals], " & _
    "[09B_Construction Release_OVP: 28 Constr Release Notif], " & _
    "[13_Substantial Completion_OVP: 40 Substantial Compl], [15_Closeout_OVP: 45 Closeout], " & _
    "[15A_Punchlist Complete_OVP: 44 Punchlist Complete]" & _
    "From [V6 data$] WHERE [Project Coordinator or BOA] = '" & BOARetail & "'  "
    
    'run the query with the sql string
    GetQueryResults2 SQLV6Retail
    
    
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