使用Excel和Access一起将变量从excel传递到Access

时间:2019-02-26 10:13:32

标签: excel vba ms-access access-vba

在excel中,我有一个链接表到一个访问表“ tbl_Output”

当前有一个手动步骤,在运行excel宏之前,我必须进入数据库并打开创建表查询,然后手动输入条件并运行。称之为字段“供应商名称”

此供应商名称存在于excel文档中。是否可以在excel中声明该变量,将其传递给访问并以该变量为条件运行创建表查询。

该任务已为许多供应商运行,因此,如果我可以自动执行此步骤,则可以创建一个遍历所有供应商的循环。

我尝试了一种变通方法,即将链接的数据透视表链接到创建表查询所基于的数据源,然后在excel数据透视表本身中进行过滤,但是由于数据量很大,刷新时间太长。

很抱歉,这很明显。对vba进行访问权限编码是我不熟悉的事情。

2 个答案:

答案 0 :(得分:0)

不是100%都在问这个问题,但我要去解决一下。下面的代码将获取供应商名称[供应商ID]的列表,并将遍历该列表,对每个供应商ID执行创建表查询,其中包含该特定供应商的信息

Sub umCreateDBTables()
    Dim DBPath As String ' Path to the database with the information
    Dim DBPath2 As String ' Path to the database to store the newly created tables in
    Dim xlCell As Range
    Dim sSQL As String
    Dim DB As DAO.Database
    Dim VenID As String
    Dim i As Integer
        DBPath = "C:\DB_Temp\AccessDB_A.accdb"
        DBPath2 = "C:\DB_Temp\AccessDB_B.accdb"
        Set DB = OpenDatabase(DBPath, True, False)
        Set xlCell = Range("A2") ' Assumes that this is the beginning of the column with your vendor ids
        Do Until xlCell.Value = "" ' Loops through the list of vendor ids until it gets to an empty cell
            VenID = "v_" & xlCell.Value ' would be best to feed this through a function to strip out any invalid db field name characters
            sSQL = "SELECT T1.F1, T1.F2, T1.F3, INTO " & VenID & " IN '" & DBPath2 & "' FROM T1 WHERE (((T1.F1)='" & xlCell.Value & "'));"
            For i = DB.TableDefs.Count - 1 To 0 Step -1 ' Cycle through the list of database objects [tables, queries, etc....]
                If DB.TableDefs(i).Name = VenID Then ' If the vendor table already exists in the DB, delete it so it can be recreated
                    DB.TableDefs.Delete (VenID)
                End Select
            Next i
            DB.Execute sSQL ' Run the SQL to create the vendor table
            Set xlCell = xlCell.Offset(1, 0) ' move down to the next row
        Loop
        DB.Close
        Set DB = Nothing
        Set xlCell = Nothing
End Sub

希望这会有所帮助

答案 1 :(得分:0)

非常感谢Glenn G

您提供的代码非常有帮助,使我朝着正确的方向前进。

尽管添加了引用,但DAO仍存在运行时问题,但是可以解决。

我要工作的代码是:

Sub UpdateDatabase()
Dim DBPath As String
Dim xlcell As Range
Dim sSQL As String, stProvider As String
Dim DB As New ADODB.Connection
    DBPath = "C:\Temp\Data.accdb"
    stProvider = "Microsoft.ACE.OLEDB.12.0"
    With DB
        .ConnectionString = DBPath
        .Provider = stProvider
        .Open
    End With
    Set xlcell = Sheet3.Range("X2")
    Do Until xlcell.Value = ""
        venid = xlcell.Value
        sSQL = "SELECT ALL * INTO tbl_Output FROM qry_Data WHERE (((qry_Data.VendorName)='" & xlcell.Value & "'));"
        DB.Execute "DROP TABLE tbl_Output;"
        DB.Execute sSQL
        Set xlcell = xlcell.Offset(1, 0)
    Loop
    DB.Close
    Set DB = Nothing
    Set xlcell = Nothing

再次感谢您的帮助。

致谢

理查德