|
|
本帖最后由 杨成云 于 2013-2-21 10:53 编辑
在Exce2013l中用ADO访问Access2013数据库，查病化疗数据库.accdb，数据库密码为：ycyNoGreen
但总提示密码错误，熟悉ADO的朋友来帮忙，着重看一下红色的代码，特别是加大加粗部分
Sub 查病化疗记录()
'在工程中引用Microsoft ADO Ext.6.0 For DDL Security对象库
'On Error Resume Next
Dim DataKey As String
Dim dic As Object, Item, KeyCount, arr
Dim cnn As New Connection, rs As New Recordset, fld As Field
Dim jie As String
Dim strSql As String, i As Long, sh As Worksheet
DataKey = "ycyoksdfc"
Set dic = CreateObject("scripting.dictionary")
jie = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & ThisWorkbook.Path & "\查病化疗数据库.accdb" & ";Jet OLEDB:Database Password=ycyNoGreen"
cnn.Open jie
Sheet2.Range("B4:N300000").ClearContents '调用数据库数据前先清空性别、出生日期与查病化疗所在列数据
'查病化疗人员基础信息-----------------------------------------------------------------
strSql = "select 姓名,身份证,家庭关系 from [A人员信息含乡村及代码] where 乡镇名称='" & Range("Q4") & "'" & " and 行政村名称='" & Range("Q5") & "'" & " and 自然村名称='" & Cells(6, "Q") & "'" & " and 户号='" & Cells(2, "L") & "'"
rs.Open strSql, cnn, odopenstatic '打开记录集
i = 1
Do While Not rs.EOF
For Each fld In rs.Fields
dic.Add i, fld.Value
i = i + 1
Next
rs.MoveNext
Loop
arr = dic.Items
j = 0
With Sheet2
For i = 0 To dic.Count / 3 - 1
k = dic.Count
.Cells(4 + i, 2) = arr(i + j)
j = j + 1
.Cells(4 + i, 3) = arr(i + j)
j = j + 1
.Cells(4 + i, 6) = arr(i + j)
Next
End With
rs.Close
dic.RemoveAll
Set dic = Nothing '清除内存中的字典
End Sub
.Range("J:J,L:L,N:N").Copy
.Columns("A:A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Columns.AutoFit '设置列宽为自动适应
End With
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
End Sub
|
|
/1 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2013-2-21 10:33
楼主
