使用多个文件协助excel宏

时间:2012-06-12 12:09:47

标签: excel vba excel-vba

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

希望图像不言自明。

enter image description here

到目前为止我没有使用excel宏,所以任何建议都值得赞赏。

谢谢, 亚历

1 个答案:

答案 0 :(得分: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

调用

测试


希望这有帮助。