VBA Dev Note - 1 - 连接Acess-优快云博客

本文介绍了一种使用VBA从Access数据库中检索数据并将其导入Excel工作表的方法。通过建立连接、设置查询语句及操作记录集，实现了数据的有效读取与展示。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

------------------------------------------------------------------------------------------------------------------------
* Get Data from access
------------------------------------------------------------------------------------------------------------------------
Sub GetData_Click()

Dim rsDept As ADODB.Recordset
Dim rsKeyProcess As ADODB.Recordset

Dim queryStringDept As String
Dim queryStringKeyProcess As String
Dim databaseFileURL As String
Dim i As Integer

Sheet3.ScrollArea = "A1:K29"


queryStringDept = "select * from Test1"
'queryStringKeyProcess = "select distinct Name from [01_Business_Process]"

Set cn = New ADODB.Connection
Set rsDept = New ADODB.Recordset
Set rsKeyProcess = New ADODB.Recordset


databaseFileURL = ThisWorkbook.Path & "\" & "test.mdb"

cn.Open "Driver={Microsoft Access Driver (*.mdb)};UID=admin;PWD=admin;DBQ=" & databaseFileURL

rsDept.Open queryStringDept, cn, adOpenForwardOnly, adLockReadOnly

iCount = rsDept.Fields.Count
For i = 0 To iCount - 1
Worksheets(1).Cells(1, i + 1).Value = rsDept.Fields(i).Name
Next
Worksheets(1).Range("A2").CopyFromRecordset rsDept

rsDept.Close
Set rsDept = Nothing


cn.Close
Set cn = Nothing


End Sub

-------------------------------------------------------------------------------------------------------------------------

Private Sub Worksheet_Activate()
Dim rsDept As ADODB.Recordset
Dim rsKeyProcess As ADODB.Recordset

Dim queryStringDept As String
Dim queryStringKeyProcess As String

Sheet3.ScrollArea = "A1:K29"

ddlRelatedDept.Clear
ddlKeyProcess.Clear

queryStringDept = "select distinct Department from [04_Department]"
queryStringKeyProcess = "select distinct Name from [01_Business_Process]"

Set cn = New ADODB.Connection
Set rsDept = New ADODB.Recordset
Set rsKeyProcess = New ADODB.Recordset


GetDatabaseFileURL
cn.Open "Driver={Microsoft Access Driver (*.mdb)};UID=admin;PWD=admin;DBQ=" & databaseFileURL

rsDept.Open queryStringDept, cn, adOpenForwardOnly, adLockReadOnly

If Not (rsDept.BOF And rsDept.EOF) Then
rsDept.MoveFirst
While Not rsDept.EOF
ddlRelatedDept.AddItem rsDept.Fields("Department")
rsDept.MoveNext
Wend

ddlRelatedDept.ListIndex = 0
End If



rsKeyProcess.Open queryStringKeyProcess, cn, adOpenForwardOnly, adLockReadOnly

If Not (rsKeyProcess.BOF And rsKeyProcess.EOF) Then
rsKeyProcess.MoveFirst
While Not rsKeyProcess.EOF
ddlKeyProcess.AddItem rsKeyProcess.Fields("Name")
rsKeyProcess.MoveNext
Wend

ddlKeyProcess.ListIndex = 0
End If

rsKeyProcess.Close
Set rsKeyProcess = Nothing

rsDept.Close
Set rsDept = Nothing


cn.Close
Set cn = Nothing

End Sub