[已解决]求助为什么保护工作表是获取数据弹出错误400

qinhuan66

求助为什么黄色区域输入序号1（有数据）可以正常获取，如果输入序号2（没此数据），弹出此对话框下图对话框。注：是在保护工作表的前提下，不保护工作表一切正常。谢谢
求助为什么没值提取弹出错误400.rar (48.06 KB, 下载次数: 6)

2013-5-24 11:36 上传

点击文件名下载附件


代码如下：
Sub tt()
Application.ScreenUpdating = False
'Dim cnn As New ADODB.Connection
Set cnn = CreateObject("adodb.connection")
'Dim rst As New ADODB.Recordset
Set rs = CreateObject("adodb.recordset")
Dim sql As String, strfiled As String, i As Integer, j As Integer
If [f2] <> "" Then
   With cnn
     .Provider = "microsoft.jet.oledb.4.0;"
     .Open ThisWorkbook.Path & "\data.mdb"
   End With
   sql = "select * from data where 序号='" & Cells(2, 6).Value & "'"
   Set rst = cnn.Execute(sql)
   If rst.BOF Then MsgBox "数据库找不到此序号": Union(Range("b:b"), Range("d:d"), Range("f:f")).ClearContents: GoTo line1           '当序号在数据库中不存在时，清除B列、D列、F列数据，并跳到line1执行
   Set d = CreateObject("scripting.dictionary")                '当序号在数据库中存在时，创建一个字典
   For i = 0 To rst.Fields.Count - 1                           '循环数据库找到的记录
       d(rst.Fields(i).Name) = rst.Fields(i).Value             '将数据库找到的记录保存到字典中
   Next
   For i = 2 To Range("a65536").End(3).Row
       For j = 1 To 6 Step 2
           Cells(i, j + 1) = d(Cells(i, j).Text)               '循环将字典的值给到对应的单元格中
       Next
   Next
   MsgBox "获取数据成功"
   cnn.Close
   Set cnn = Nothing
End If
line1:
Application.ScreenUpdating = True
End Sub

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-5-24 12:23

1. Sub tt()
   
2.     Application.ScreenUpdating = False
   
3.     'Dim cnn As New ADODB.Connection
   
4.     Set cnn = CreateObject("adodb.connection")
   
5.     'Dim rst As New ADODB.Recordset
   
6.     Set rs = CreateObject("adodb.recordset")
   
7.     Dim sql As String, strfiled As String, i As Integer, j As Integer
   
8.     If [f2] <> "" Then
   
9.         With cnn
   
10.             .Provider = "microsoft.jet.oledb.4.0;"
    
11.             .Open ThisWorkbook.Path & "\data.mdb"
    
12.         End With
    
13.         sql = "select * from data where 序号='" & Cells(2, 6).Value & "'"
    
14.         Set rst = cnn.Execute(sql)
    
15.         If rst.BOF Then
    
16.             MsgBox "数据库找不到此序号"
    
17.             ActiveSheet.Unprotect "695360052"
    
18.             Union(Range("b:b"), Range("d:d"), Range("f:f")).ClearContents
    
19.             ActiveSheet.Protect "695360052"
    
20.              GoTo line1           '当序号在数据库中不存在时，清除B列、D列、F列数据，并跳到line1执行
    
21.         End If
    
22.         Set d = CreateObject("scripting.dictionary")                '当序号在数据库中存在时，创建一个字典
    
23.         For i = 0 To rst.Fields.Count - 1                           '循环数据库找到的记录
    
24.             d(rst.Fields(i).Name) = rst.Fields(i).Value             '将数据库找到的记录保存到字典中
    
25.         Next
    
26.         For i = 2 To Range("a65536").End(3).Row
    
27.             For j = 1 To 6 Step 2
    
28.                 Cells(i, j + 1) = d(Cells(i, j).Text)               '循环将字典的值给到对应的单元格中
    
29.             Next
    
30.         Next
    
31.         MsgBox "获取数据成功"
    
32.         cnn.Close
    
33.         Set cnn = Nothing
    
34.     End If
    
35. line1:
    
36.     Application.ScreenUpdating = True
    
37. End Sub
    

复制代码

跳转到最佳答案楼层

hwc2ycy

hwc2ycy

你在保护的状态下清除内容，肯定要报错了。

qinhuan66

hwc2ycy 发表于 2013-5-24 12:20
你在保护的状态下清除内容，肯定要报错了。

老师那怎么改才好呢？谢谢

hwc2ycy

1. Sub tt()
   
2.     Application.ScreenUpdating = False
   
3.     'Dim cnn As New ADODB.Connection
   
4.     Set cnn = CreateObject("adodb.connection")
   
5.     'Dim rst As New ADODB.Recordset
   
6.     Set rs = CreateObject("adodb.recordset")
   
7.     Dim sql As String, strfiled As String, i As Integer, j As Integer
   
8.     If [f2] <> "" Then
   
9.         With cnn
   
10.             .Provider = "microsoft.jet.oledb.4.0;"
    
11.             .Open ThisWorkbook.Path & "\data.mdb"
    
12.         End With
    
13.         sql = "select * from data where 序号='" & Cells(2, 6).Value & "'"
    
14.         Set rst = cnn.Execute(sql)
    
15.         If rst.BOF Then
    
16.             MsgBox "数据库找不到此序号"
    
17.             ActiveSheet.Unprotect "695360052"
    
18.             Union(Range("b:b"), Range("d:d"), Range("f:f")).ClearContents
    
19.             ActiveSheet.Protect "695360052"
    
20.              GoTo line1           '当序号在数据库中不存在时，清除B列、D列、F列数据，并跳到line1执行
    
21.         End If
    
22.         Set d = CreateObject("scripting.dictionary")                '当序号在数据库中存在时，创建一个字典
    
23.         For i = 0 To rst.Fields.Count - 1                           '循环数据库找到的记录
    
24.             d(rst.Fields(i).Name) = rst.Fields(i).Value             '将数据库找到的记录保存到字典中
    
25.         Next
    
26.         For i = 2 To Range("a65536").End(3).Row
    
27.             For j = 1 To 6 Step 2
    
28.                 Cells(i, j + 1) = d(Cells(i, j).Text)               '循环将字典的值给到对应的单元格中
    
29.             Next
    
30.         Next
    
31.         MsgBox "获取数据成功"
    
32.         cnn.Close
    
33.         Set cnn = Nothing
    
34.     End If
    
35. line1:
    
36.     Application.ScreenUpdating = True
    
37. End Sub
    

复制代码

hwc2ycy

先取消保护，清除行数据后再保护。

qinhuan66

hwc2ycy 发表于 2013-5-24 12:23

老师你好！经测试没值是可以，可是有值反而是这样了（400）。谢谢

调个位置可以了。谢谢

hwc2ycy

我刚查了下400是窗体的报错的，

hwc2ycy

但是直接调用，第一次的报错确实是清除内容这段代码里。