[已解决]vba代码调用网络数据库问题

toylife

如何将这段代码里面的数据库位置改成网络的，网络地址：\\10.127.10.234\中转文件\贴片回流焊数据\QC报表数据库\gkzp.mdb
Private Sub CommandButton6_Click()
    Dim cnn As Object, rs As Object, sql$, i&, m&, c As Range
    If Len(Range("b3").Value) = 0 Then MsgBox " 请在 B3 单元可输入要查询的机型", vbCritical + vbOKOnly: Exit Sub
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Set cnn = CreateObject("adodb.connection")
    Set rs = CreateObject("adodb.recordset")

    cnn.Open "provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.Path & "\gkzp.mdb;Jet OLEDB:Database Password=263214685"

    sql = "select 班组,生产线,不良类型,不良位置,不良数量,生产日期,单机点数,总点数,不良总数,操作员,生产周期,产量,疵点率 from gkzp where 机型='" & [B3] & "'"
    rs.Open sql, cnn, 1, 3
    If rs.RecordCount > 0 Then
        If rs.RecordCount > 1 Then
            '            MsgBox Target.Value & "共有" & rs.RecordCount & "条记录", vbInformation
            For i = 1 To rs.RecordCount
                m = 0
                For Each c In Range("F3,J3,B4,F4,J4,L4,B5,F5,J5,L6,L5,J6,K8")
                    c.Value = rs.Fields(m).Value
                    m = m + 1
                Next

                If i < rs.RecordCount Then
                    If MsgBox("共有" & rs.RecordCount & "条记录，这是第" & i & "条记录，单击“是”显示下一条，单击“否”退出程序。", vbInformation + vbYesNo, [B3] & "共有" & rs.RecordCount & "条记录") = vbNo Then Exit For
                End If
                rs.MoveNext
            Next
        Else

            For Each c In Range("F3,J3,B4,F4,J4,L4,B5,F5,J5,L6,L5,J6,K8")
                c.Value = rs.Fields(m).Value
                m = m + 1
            Next
            MsgBox "获取成功！"  '提示可要可不要
        End If
    Else
        Range("F3,J3,B4,F4,J4,L4,B5,F5,J5,L6,L5,J6,K8") = ""
    End If
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    rs.Close
    Set rs = Nothing
    cnn.Close
    Set cnn = Nothing

End Sub

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-6-18 13:03

1. Private Sub CommandButton6_Click()
   
2.     Dim cnn As Object, rs As Object, sql$, i&, m&, c As Range
   
3.     Dim strDatabase$
   
4. 
   
5.     If Len(Range("b3").Value) = 0 Then MsgBox " 请在 B3 单元可输入要查询的机型", vbCritical + vbOKOnly: Exit Sub
   
6.     strDatabase = "\\10.127.10.234\中转文件\贴片回流焊数据\QC报表数据库"
   
7.     Application.ScreenUpdating = False
   
8.     Application.DisplayAlerts = False
   
9.     Application.EnableEvents = False
   
10.     Set cnn = CreateObject("adodb.connection")
    
11.     Set rs = CreateObject("adodb.recordset")
    
12. 
    
13.     cnn.Open "provider=microsoft.jet.oledb.4.0;data source=" & strDatabase & "gkzp.mdb;Jet OLEDB:Database Password=263214685"
    
14. 
    
15.     sql = "select 班组,生产线,不良类型,不良位置,不良数量,生产日期,单机点数,总点数,不良总数,操作员,生产周期,产量,疵点率 from gkzp where 机型='" & [B3] & "'"
    
16.     rs.Open sql, cnn, 1, 3
    
17.     If rs.RecordCount > 0 Then
    
18.         If rs.RecordCount > 1 Then
    
19.             '            MsgBox Target.Value & "共有" & rs.RecordCount & "条记录", vbInformation
    
20.             For i = 1 To rs.RecordCount
    
21.                 m = 0
    
22.                 For Each c In Range("F3,J3,B4,F4,J4,L4,B5,F5,J5,L6,L5,J6,K8")
    
23.                     c.Value = rs.Fields(m).Value
    
24.                     m = m + 1
    
25.                 Next
    
26. 
    
27.                 If i < rs.RecordCount Then
    
28.                     If MsgBox("共有" & rs.RecordCount & "条记录，这是第" & i & "条记录，单击“是”显示下一条，单击“否”退出程序。", vbInformation + vbYesNo, [B3] & "共有" & rs.RecordCount & "条记录") = vbNo Then Exit For
    
29.                 End If
    
30.                 rs.MoveNext
    
31.             Next
    
32.         Else
    
33. 
    
34.             For Each c In Range("F3,J3,B4,F4,J4,L4,B5,F5,J5,L6,L5,J6,K8")
    
35.                 c.Value = rs.Fields(m).Value
    
36.                 m = m + 1
    
37.             Next
    
38.             MsgBox "获取成功！"  '提示可要可不要
    
39.         End If
    
40.     Else
    
41.         Range("F3,J3,B4,F4,J4,L4,B5,F5,J5,L6,L5,J6,K8") = ""
    
42.     End If
    
43.     Application.ScreenUpdating = True
    
44.     Application.DisplayAlerts = True
    
45.     Application.EnableEvents = True
    
46.     rs.Close
    
47.     Set rs = Nothing
    
48.     cnn.Close
    
49.     Set cnn = Nothing
    
50. 
    
51. End Sub
    

复制代码

跳转到最佳答案楼层

hwc2ycy

1. Private Sub CommandButton6_Click()
   
2.     Dim cnn As Object, rs As Object, sql$, i&, m&, c As Range
   
3.     Dim strDatabase$
   
4. 
   
5.     If Len(Range("b3").Value) = 0 Then MsgBox " 请在 B3 单元可输入要查询的机型", vbCritical + vbOKOnly: Exit Sub
   
6.     strDatabase = "\\10.127.10.234\中转文件\贴片回流焊数据\QC报表数据库"
   
7.     Application.ScreenUpdating = False
   
8.     Application.DisplayAlerts = False
   
9.     Application.EnableEvents = False
   
10.     Set cnn = CreateObject("adodb.connection")
    
11.     Set rs = CreateObject("adodb.recordset")
    
12. 
    
13.     cnn.Open "provider=microsoft.jet.oledb.4.0;data source=" & strDatabase & "gkzp.mdb;Jet OLEDB:Database Password=263214685"
    
14. 
    
15.     sql = "select 班组,生产线,不良类型,不良位置,不良数量,生产日期,单机点数,总点数,不良总数,操作员,生产周期,产量,疵点率 from gkzp where 机型='" & [B3] & "'"
    
16.     rs.Open sql, cnn, 1, 3
    
17.     If rs.RecordCount > 0 Then
    
18.         If rs.RecordCount > 1 Then
    
19.             '            MsgBox Target.Value & "共有" & rs.RecordCount & "条记录", vbInformation
    
20.             For i = 1 To rs.RecordCount
    
21.                 m = 0
    
22.                 For Each c In Range("F3,J3,B4,F4,J4,L4,B5,F5,J5,L6,L5,J6,K8")
    
23.                     c.Value = rs.Fields(m).Value
    
24.                     m = m + 1
    
25.                 Next
    
26. 
    
27.                 If i < rs.RecordCount Then
    
28.                     If MsgBox("共有" & rs.RecordCount & "条记录，这是第" & i & "条记录，单击“是”显示下一条，单击“否”退出程序。", vbInformation + vbYesNo, [B3] & "共有" & rs.RecordCount & "条记录") = vbNo Then Exit For
    
29.                 End If
    
30.                 rs.MoveNext
    
31.             Next
    
32.         Else
    
33. 
    
34.             For Each c In Range("F3,J3,B4,F4,J4,L4,B5,F5,J5,L6,L5,J6,K8")
    
35.                 c.Value = rs.Fields(m).Value
    
36.                 m = m + 1
    
37.             Next
    
38.             MsgBox "获取成功！"  '提示可要可不要
    
39.         End If
    
40.     Else
    
41.         Range("F3,J3,B4,F4,J4,L4,B5,F5,J5,L6,L5,J6,K8") = ""
    
42.     End If
    
43.     Application.ScreenUpdating = True
    
44.     Application.DisplayAlerts = True
    
45.     Application.EnableEvents = True
    
46.     rs.Close
    
47.     Set rs = Nothing
    
48.     cnn.Close
    
49.     Set cnn = Nothing
    
50. 
    
51. End Sub
    

复制代码

hwc2ycy

就定义了一个变量存储网络路径，
然后替换掉原有的THISWORKBOOK.PATH

toylife

好像不行啊，提示运行时错误‘-2147217865 （80040e37）’：
自动化（Automation）错误

hwc2ycy

网络连接是否正常，你打开共享里的文件是否正常？

hwc2ycy

strDatabase = "\\10.127.10.234\中转文件\贴片回流焊数据\QC报表数据库\"
改成
strDatabase = "'\\10.127.10.234\中转文件\贴片回流焊数据\QC报表数据库\"

cnn.Open "provider=microsoft.jet.oledb.4.0;data source=" & strDatabase & "gkzp.mdb;Jet OLEDB:Database Password=263214685"
改成
cnn.Open "provider=microsoft.jet.oledb.4.0;data source=" & strDatabase & "gkzp.mdb';Jet OLEDB:Database Password=263214685"

hwc2ycy

msgbox dir("\\10.127.10.234\中转文件\贴片回流焊数据\QC报表数据库\gkzp.mdb")
或者先用这个测试，可以检测文件。

toylife

msgbox dir("\\10.127.10.234\中转文件\贴片回流焊数据\QC报表数据库\gkzp.mdb")用这有弹出 GKZP.mdb

strDatabase = "\\10.127.10.234\中转文件\贴片回流焊数据\QC报表数据库\"
改成
strDatabase = "'\\10.127.10.234\中转文件\贴片回流焊数据\QC报表数据库\"

cnn.Open "provider=microsoft.jet.oledb.4.0;data source=" & strDatabase & "gkzp.mdb;Jet OLEDB:Database Password=263214685"
改成
cnn.Open "provider=microsoft.jet.oledb.4.0;data source=" & strDatabase & "gkzp.mdb';Jet OLEDB:Database Password=263214685"
之后变成数据库引擎找不到输入和查询 gkzp 请确认是否存在

hwc2ycy

strDatabase = "\\10.127.10.234\中转文件\贴片回流焊数据\QC报表数据库\gkzp.mdb“
cnn.Open "provider=microsoft.jet.oledb.4.0;data source=" & strDatabase & ";Jet OLEDB:Database Password=263214685"

错误码是多少来着。

hwc2ycy

你留个QQ，我远程瞧瞧吧。