根据2个标准填写用户自定义工作簿中的数据 [英] Fill Userform with data from closed workbook, based on 2 criteria

问题描述

我无法使用ADODB在封闭的工作簿中搜索数据，按团队缩小（A，B，C，D）和日期，并使用封闭的工作簿中的数据填充活动工作簿中的用户表。我的第一个问题是让连接字符串正常工作，我想要达到的文件在同一个目录，但ThisWorkbook.Path似乎没有工作。我试图拉动的数据是团队，日期，产品，人员配置，处理问题和包装问题。另外我不确定如何在选择它之后使用数据。这是从另一个答案中采取的代码，我无法适应我的需要。

 子ADOGetRange（）
 
 Dim lastRow As Long，x As Long 
 
 Const adOpenKeyset = 1 
 Const adLockOptimistic = 3 
 Dim conn 
 Dim EmployeeData 
 
 Set conn = CreateObject（ADODB.Connection）
 conn.ConnectionString =Provider = Microsoft.ACE.OLEDB.12.0;数据源=工作簿（ThisWorkbook.Path）&\Line 1  -  EOS数据库Rev A.xlsm [Line 1 Database $];扩展属性=Excel 12.0 Xml; HDR = YES; 
 conn.Open 
 
'On Error GoTo CloseConnection 
 
设置L1EOSData = CreateObject（ADODB.Recordset）
 
使用L1EOSData 
 .ActiveConnection = conn 
 .CursorType = adOpenKeyset 
 .LockType = adLockOptimistic 
 .Source =SELECT * FROM [Line 1 Database $] WHERE [Team] ='& cboL1Team.Value& 而[Date] =＃& DateValue（cboL1Date.Value）& ＃
 .Open 
'On Error GoTo CloseRecordset 
 
 End with 
 
 CloseRecordset：
 
 L1EOSData.Close 
设置L1EOSData = Nothing 
 
 CloseConnection：
 conn.Close 
 Set conn = Nothing 
 End Sub 
  / pre> 
 
解决方案
您将不得不相应调整字段名称。
  Private Sub cboL1Date_Change（）
'如果cboL1Team.ListIndex> -1 Then ReadWriteRecord enReadRecord 
如果cboL1Team.ListIndex> -1然后ADOGetRange 
 End Sub 
 
 Private Sub cboL1Team_Change（）
'如果cboL1Date.ListIndex> -1 Then ReadWriteRecord enReadRecord 
如果cboL1Date.ListIndex> -1然后ADOGetRange 
 End Sub 
 
 Sub ADOGetRange（）
 Const adOpenKeyset = 1 
 Const adLockOptimistic = 3 
 Dim conn 
 Dim L1EOSData 
 
 Set conn = CreateObject（ADODB.Connection）
 conn.ConnectionString =Provider = Microsoft.ACE.OLEDB.12.0; Data Source =& ThisWorkbook.Path& \Line 1  -  EOS数据库Rev A.xlsm;扩展属性=Excel 12.0 Xml; HDR = YES; 
 conn.Open 
 
'On Error GoTo CloseConnection 
 
设置L1EOSData = CreateObject（ADODB.Recordset）
 
使用L1EOSData 
 .ActiveConnection = conn 
 .CursorType = adOpenKeyset 
 .LockType = adLockOptimistic 
 .Source =SELECT * FROM [Line 1 Database $] WHERE [Team] ='& cboL1Team.Value& 而[日期] =＃& DateValue（cboL1Date.Value）& ＃
 .Open 
'On Error GoTo CloseRecordset 
 
 
如果不是.BOF或不是.EOF然后
 cboL1Product.Value = .Fields $
 cboL1Staffing.Value = .Fields（Staffing）。 （处理）价值
 txtL1Packaging.Value = .Fields（包装）价值
如果
 
结束
 
 CloseRecordset： 
 
 L1EOSData.Close 
设置L1EOSData = Nothing 
 
 CloseConnection：
 conn.Close 
设置conn = Nothing 
 End Sub 
  
 
I am having trouble using ADODB to search data in a closed workbook, narrow by team (think A, B, C, D) and Date and fill a userform in the active workbook with the data from the closed workbook. My first issue is with getting the connection string to work, the file I am trying to reach is in the same directory but ThisWorkbook.Path doesn't seem to be working. The data I am trying to pull is Team, Date, Product, Staffing, Processing Issues, and Packaging Issues. Also I am unsure how to use the data after I have selected it.  This is code taken from another answer which I am having trouble fitting to my needs.
Sub ADOGetRange()

Dim lastRow As Long, x As Long

Const adOpenKeyset = 1
Const adLockOptimistic = 3
Dim conn
Dim EmployeeData

Set conn = CreateObject("ADODB.Connection")
conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=Workbooks(ThisWorkbook.Path) & "\Line 1 - EOS Database Rev A.xlsm[Line 1 Database$]";Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
conn.Open

' On Error GoTo CloseConnection

Set L1EOSData = CreateObject("ADODB.Recordset")

With L1EOSData
    .ActiveConnection = conn
    .CursorType = adOpenKeyset
    .LockType = adLockOptimistic
    .Source = "SELECT * FROM [Line 1 Database$] WHERE [Team]='" & cboL1Team.Value & "" And [Date] = "#" & DateValue(cboL1Date.Value) & "#"
    .Open
'     On Error GoTo CloseRecordset

End With

CloseRecordset:

L1EOSData.Close
Set L1EOSData = Nothing

CloseConnection:
conn.Close
Set conn = Nothing
End Sub 

解决方案
You will have to adjust the field names accordingly.
Private Sub cboL1Date_Change()
'  If cboL1Team.ListIndex > -1 Then ReadWriteRecord enReadRecord
    If cboL1Team.ListIndex > -1 Then ADOGetRange
End Sub

Private Sub cboL1Team_Change()
'  If cboL1Date.ListIndex > -1 Then ReadWriteRecord enReadRecord
    If cboL1Date.ListIndex > -1 Then ADOGetRange
End Sub

Sub ADOGetRange()
    Const adOpenKeyset = 1
    Const adLockOptimistic = 3
    Dim conn
    Dim L1EOSData

    Set conn = CreateObject("ADODB.Connection")
    conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\Line 1 - EOS Database Rev A.xlsm;Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
    conn.Open

    ' On Error GoTo CloseConnection

    Set L1EOSData = CreateObject("ADODB.Recordset")

    With L1EOSData
        .ActiveConnection = conn
        .CursorType = adOpenKeyset
        .LockType = adLockOptimistic
        .Source = "SELECT * FROM [Line 1 Database$] WHERE [Team]='" & cboL1Team.Value & "' And [Date] = #" & DateValue(cboL1Date.Value) & "#"
        .Open
        '     On Error GoTo CloseRecordset


        If Not .BOF Or Not .EOF Then
            cboL1Product.Value = .Fields("Product").Value
            cboL1Staffing.Value = .Fields("Staffing").Value
            txtL1Pounds.Value = .Fields("Pounds").Value
            txtL1Processing.Value = .Fields("Processing").Value
            txtL1Packaging.Value = .Fields("Packaging").Value
        End If

    End With

CloseRecordset:

    L1EOSData.Close
    Set L1EOSData = Nothing

CloseConnection:
    conn.Close
    Set conn = Nothing
End Sub


                        
这篇关于根据2个标准填写用户自定义工作簿中的数据的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！