vba - 协助使用多个文件的 excel 宏

Question

我有两个包含相关数据的 excel 文件。我正在尝试创建一个能够从 db.xls 查询数据并使用正确值填充 data.xls 的宏。

希望图像是不言自明的。

直到现在我才使用 excel 宏，所以任何建议都值得赞赏。

谢谢，亚历克斯

Answer 1

核心功能

Private Function GetValues(dataFilePath$, dbFilePath$) As String
    '///add a reference
    '1. Microsoft ActiveX Data Objects 2.8 Library
    Dim cn1 As New ADODB.Connection, cn2 As New ADODB.Connection
    Dim rs1 As New ADODB.Recordset, rs2 As New ADODB.Recordset
    Dim resultstring$, pos&, sql$
    Call dbConnect_xls(cn1, dataFilePath)
    Call dbConnect_xls(cn2, dbFilePath)
    Set rs1 = cn1.Execute("select *from [Sheet1$];")

    While Not rs1.EOF
        sql = "select *from [sheet1$] where type='" & rs1.Fields(0).Value & "';"
        Set rs2 = cn2.Execute(sql)
        While Not rs2.EOF
            Dim rcount&, tmp$
            rcount = rs2.Fields.Count
            For pos = 0 To rcount - 1
                tmp = tmp & vbTab & rs2.Fields(pos).Value
            Next
            resultstring = resultstring & tmp & vbCrLf
            tmp = ""
            rs2.MoveNext
        Wend
        rs2.Close
        rs1.MoveNext
    Wend

    rs1.Close
    cn1.Close
    cn2.Close

    GetValues = resultstring

End Function

连接处理程序

Private Function dbConnect_xls(dbConn As ADODB.Connection, dbPath As String) As Boolean
On Error GoTo dsnErr
    With dbConn
        .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
        .Open
    End With
    dbConnect_xls = True
    Exit Function
dsnErr:
    Err.Clear
    If dbConn.State > 0 Then dbConn.Close: Call dbConnect_xls(dbConn, dbPath)
    dbConnect_xls = False
End Function

和测试仪

Public Sub tester()
    Dim d1$, d2$
    d1 = InputBox("Enter datafile path:")
    d2 = InputBox("Enter dbfile path:")
    If Dir(d1) <> "" And Dir(d2) <> "" Then
        Dim x$
        x = GetValues(d1, d2)
        MsgBox x
        'Call GetValues("C:\data.xls", "C:\db.xls")
    Else
        MsgBox "Invalid path provided."
    End If
End Sub

并且可以从immediate window

测试仪

---

希望这可以帮助。