Question

我工作的人要求我更改他们现有的订单系统，因为它已经很老了，他们想要更新。因此，我已将表格移动到Excel，就像他们要求的那样，它不会出现在订单表格中，但他们也希望这样，以便当他们点击＆＃34;贸易帐户＆＃34;在Excel表单上的按钮，它打开一个Access in Access（已完成），要求他们输入帐户信息（公司名称）。完成后，它会显示所有帐户信息供他们查看，现在这就是我被困住的地方。他们希望我这样做，以便将出现的信息复制到Excel文档的交易帐户字段中，这样他们就不必花时间手工输入，我目前不知道如何做到这一点我没有在这里使用VBA的经验。（可能听起来很愚蠢，但我试图学习）

如果可以更好地解释它，我也可以提供图像。

Answer 1

可能有很多方法可以做到这一点。这是一个。

我正在使用Northwind数据库！

使用Sheet1中的以下向量：

在Excel中运行以下脚本，结果将复制到Sheet2中。哦，别忘了设置对Microsoft ADO 2.8的引用!!

'Set db = ws.OpenDatabase("C:\your_path\Northwind.mdb")

Sub DAOParamTest()
Dim cn As Object
Dim rs As Object
Dim strFile As String
Dim strCon As String
Dim strSQL As String
Dim s As String
Dim i As Integer, j As Integer
Dim rCell As Range
Dim rRng As Range
Dim sht As Worksheet
Dim LastRow As Long
Dim MyCell As Range


''Access database

strFile = "C:\your_path\Northwind.mdb"

strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile & ";"

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open strCon

'Rough idea
Set sht = ThisWorkbook.Worksheets("Sheet1")
Worksheets("Sheet1").Select
LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
Set rRng = Sheet1.Range("A1:A" & LastRow)

For Each MyCell In rRng
intID = MyCell

    strSQL = "SELECT * " _
           & "FROM [Order Details] " _
           & "WHERE OrderID = " & intID

    rs.Open strSQL, cn
        Worksheets("Sheet2").Select
        LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row + 1
        Worksheets("Sheet2").Cells(LastRow, 1).CopyFromRecordset rs
    rs.Close

Next MyCell

''Tidy up
Set rs = Nothing
cn.Close
Set cn = Nothing

End Sub

这是您需要考虑的另一种解决方案。

http://www.erlandsendata.no/english/index.php?d=envbadacimportado

Answer 2

我用另一种解决方案回答了你的另一个问题。这是使用Query执行所需操作的另一种方法。这很好，因为您可以像过滤器一样控制查询，并从该对象导入结果。

' Set a reference to DAO 6.0

    Sub GetQuery()
        Dim dbs As DAO.Database
        Dim rst As DAO.Recordset
        Dim i As Long
        Dim wsh As Worksheet
        Set dbs = DBEngine.OpenDatabase("C:\your_path\Northwind.mdb")
        Set rst = dbs.OpenRecordset("Invoices")
        Set wsh = Worksheets("Sheet3")
        For i = 0 To rst.Fields.Count - 1
            wsh.Cells(1, i + 1).Value = rst.Fields(i).Name
        Next
        wsh.Range("A1").Resize(ColumnSize:=rst.Fields.Count).Font.Bold = True
        wsh.Range("A2").CopyFromRecordset rst
        rst.Close
        Set rst = Nothing
        dbs.Close
        Set dbs = Nothing
    End Sub

使用VBA将Access中的特定数据复制到Excel上的特定字段中

2 个答案: