[已解决]如何根据黄色单元的单位名称和姓名在ACCESS数据提取相符的资料到绿色单元格

qinhuan66 · 发表于 2014-1-23 12:02

本帖最后由 qinhuan66 于 2014-1-23 19:33 编辑

如何根据黄色单元的单位名称和姓名在ACCESS数据提取相符的资料到绿色单元格.工作表密码:695360052
数据库密码:695360052

个人信息.rar (238.82 KB, 下载次数: 10)

2014-1-23 12:01 上传

点击文件名下载附件

图1:下图是需要从数据库提取的表

图2:下图是上图1需要提供的数据

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2014-1-23 18:46

Option Explicit
Const adUseClient = 3
Const adModeShareDenyWrite = 8
Const adModeReadWrite = 3
Const adModeRead = 1
Dim AdoConn As Object, AdoRst As Object
Sub Main()
Dim strSql$
If Len([c2].Value) = 0 Or Len([b3].Value) = 0 Then
MsgBox "信息不完整"
Exit Sub
End If
If Not OpenConnect(ThisWorkbook.Path & Application.PathSeparator & "data.mdb", "695360052") Then
Exit Sub
End If
strSql = "select * from 个人信息 where 单位名称='" & [c2].Value & "' and 姓名='" & [b3].Value & "'"
If Not RunSql(strSql) Then
Exit Sub
End If
With AdoRst
If .RecordCount < 1 Then
MsgBox "无符合条件的记录"
.Close
Exit Sub
End If
Range("j2").Value = .Fields("单位性质").Value '单位性质
Range("n2").Value = .Fields("参保类别").Value '参保类别
Range("h3").Value = .Fields("身份证号").Value '身份证号
Range("q2").Value = .Fields("参保时间").Value '时间
Range("q3").Value = .Fields("参加工作时间").Value '参加工作时间
Range("t3").Value = .Fields("联系地址").Value '地址
End With
MsgBox "ok"
Set AdoRst = Nothing
End Sub
Function OpenConnect(strFullname As String, Optional dbpasswd As String = "") As Boolean
Dim StrConn$
On Error GoTo ErrorHandler
If AdoConn Is Nothing Then
Set AdoConn = CreateObject("ADODB.Connection")
Else
OpenConnect = True
Exit Function
End If
Select Case Application.Version
Case "14.0", "12.0"
StrConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source='" & _
strFullname & "';Jet OLEDB:Database Password='" & dbpasswd & "';"
Case Else
StrConn = "Provider= Microsoft.Jet.OLEDB.4.0;" & _
"Data Source='" & strFullname & "';Jet OLEDB:Database Password='" & dbpasswd & "';"
End Select
With AdoConn
.CommandTimeout = 5
.ConnectionTimeout = 5
.CursorLocation = adUseClient
.Mode = adModeRead
.ConnectionString = StrConn
.Open
End With
OpenConnect = True
Exit Function
ErrorHandler:
MsgBox Err.Number & vbCrLf & Err.Description
Set AdoRst = Nothing
Set AdoConn = Nothing
End Function
Function RunSql(sql As String) As Boolean
On Error GoTo ErrorHandler
Set AdoRst = AdoConn.Execute(sql)
RunSql = True
Exit Function
ErrorHandler:
MsgBox Err.Number & vbCrLf & Err.Description
End Function

复制代码

跳转到最佳答案楼层

hwc2ycy · 发表于 2014-1-23 18:19

还是用SQL查询呀，相关的RECORD直接写到相对应的单元格。
如果有多条相符的记录，如何取舍？

qinhuan66 · 发表于 2014-1-23 18:27

hwc2ycy 发表于 2014-1-23 18:19
还是用SQL查询呀，相关的RECORD直接写到相对应的单元格。
如果有多条相符的记录，如何取舍？

应该同一个单位相同名字极少数的，如果碰到相同的弹出提示需要那条信息。谢谢。
例如：

hwc2ycy · 发表于 2014-1-23 18:46

这个最佳答案由 hwc2ycy 给出，感谢 hwc2ycy 的回答。

单击隐藏图章

Option Explicit
Const adUseClient = 3
Const adModeShareDenyWrite = 8
Const adModeReadWrite = 3
Const adModeRead = 1
Dim AdoConn As Object, AdoRst As Object
Sub Main()
Dim strSql$
If Len([c2].Value) = 0 Or Len([b3].Value) = 0 Then
MsgBox "信息不完整"
Exit Sub
End If
If Not OpenConnect(ThisWorkbook.Path & Application.PathSeparator & "data.mdb", "695360052") Then
Exit Sub
End If
strSql = "select * from 个人信息 where 单位名称='" & [c2].Value & "' and 姓名='" & [b3].Value & "'"
If Not RunSql(strSql) Then
Exit Sub
End If
With AdoRst
If .RecordCount < 1 Then
MsgBox "无符合条件的记录"
.Close
Exit Sub
End If
Range("j2").Value = .Fields("单位性质").Value '单位性质
Range("n2").Value = .Fields("参保类别").Value '参保类别
Range("h3").Value = .Fields("身份证号").Value '身份证号
Range("q2").Value = .Fields("参保时间").Value '时间
Range("q3").Value = .Fields("参加工作时间").Value '参加工作时间
Range("t3").Value = .Fields("联系地址").Value '地址
End With
MsgBox "ok"
Set AdoRst = Nothing
End Sub
Function OpenConnect(strFullname As String, Optional dbpasswd As String = "") As Boolean
Dim StrConn$
On Error GoTo ErrorHandler
If AdoConn Is Nothing Then
Set AdoConn = CreateObject("ADODB.Connection")
Else
OpenConnect = True
Exit Function
End If
Select Case Application.Version
Case "14.0", "12.0"
StrConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source='" & _
strFullname & "';Jet OLEDB:Database Password='" & dbpasswd & "';"
Case Else
StrConn = "Provider= Microsoft.Jet.OLEDB.4.0;" & _
"Data Source='" & strFullname & "';Jet OLEDB:Database Password='" & dbpasswd & "';"
End Select
With AdoConn
.CommandTimeout = 5
.ConnectionTimeout = 5
.CursorLocation = adUseClient
.Mode = adModeRead
.ConnectionString = StrConn
.Open
End With
OpenConnect = True
Exit Function
ErrorHandler:
MsgBox Err.Number & vbCrLf & Err.Description
Set AdoRst = Nothing
Set AdoConn = Nothing
End Function
Function RunSql(sql As String) As Boolean
On Error GoTo ErrorHandler
Set AdoRst = AdoConn.Execute(sql)
RunSql = True
Exit Function
ErrorHandler:
MsgBox Err.Number & vbCrLf & Err.Description
End Function

复制代码

hwc2ycy · 发表于 2014-1-23 18:48

基本的模型有了，其余的你就自己试着完善吧。

hwc2ycy · 发表于 2014-1-23 21:28

可以要选择文件用这个貌似更简单Application.GetOpenFilename

		自动登录	找回密码
密码			注册