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

Question

The people I work for have asked me to change up the order system they currently have in place as it is quite old and they want to update. So I have moved the table to Excel like they have asked so that it does not sit on the order form but they also want it so that when they click on the "Trade Account" button on the Excel form it opens a Query in Access (Which is all done) that asks them to enter in the account information (company name). When that is done it will bring up all the account information for them to see, now this is where I am stuck. They would like me to make it so that the information that comes up is copied into the trade account fields in the Excel document so that they do not have to spend time typing it out by hand and I currently have no idea how to do this as I do not have experience using VBA on here. (Probably sounds dumb but i'm trying to learn)

I can also provide images if that would explain it better.

Answer 1

There are probably many ways to do this. Here is one.

I am using the Northwind Database!

With the following vector in Sheet1:

10248
10249
10250
10251
10252

Run the following script, in Excel, and the results will be copied into Sheet2. Oh, don't forget to set a reference to 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

Here is yet another solution for you to consider.

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

Answer 2

I answered your other question with a different solution. Here is another way to do what you want, using a Query. This is nice because you can control the query like a filter, and import the results from that object.

' 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