|
|
运行下面程序出现向上面图的问题，请问怎么解决，俺们是菜鸟，请帮我修改，程序也是论坛中搜到的，自己修改一番，发现追加30条纪录一下可以实现，但是向下面这么多就没有办法了，请问怎么解决？！
我的用途是把excl中的BR1:EF2的内容追加写入mdb库中，因为BR1:EF2内容是会改变的，我运行程序把数据追加到数据库中！
那位大侠能不能写出简洁好用的？！帮忙
Sub 录入()
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim sq1 As String, arr1, i As Integer, mykey As String
cnn.Open "provider=Microsoft.jet.OLEDB.4.0;data source=" & ThisWorkbook.Path & "\zzz.mdb"
sq1 = "Select * from zzz"
rst.Open sq1, cnn, adOpenKeyset, adLockOptimistic
arr1 = Sheets("数据").Range("BR1:EF2")
mykey = UCase(Sheets("数据").[BR1])
For i = 2 To UBound(arr1)
If UCase(arr1(1, 1)) = mykey Then
rst.AddNew
kk = kk + 1
rst.Fields("BR2") = arr1(i, 1)
rst.Fields("BR3") = arr1(i, 2)
rst.Fields("BR4") = arr1(i, 3)
rst.Fields("BR5") = arr1(i, 4)
rst.Fields("BR6") = arr1(i, 5)
rst.Fields("BR7") = arr1(i, 6)
rst.Fields("BR8") = arr1(i, 7)
rst.Fields("BR9") = arr1(i, 8)
rst.Fields("BR10") = arr1(i, 9)
rst.Fields("BR11") = arr1(i, 10)
rst.Fields("BR12") = arr1(i, 11)
rst.Fields("BR13") = arr1(i, 12)
rst.Fields("BR14") = arr1(i, 13)
rst.Fields("BR15") = arr1(i, 14)
rst.Fields("BR16") = arr1(i, 15)
rst.Fields("BR17") = arr1(i, 16)
rst.Fields("BR18") = arr1(i, 17)
rst.Fields("BR19") = arr1(i, 18)
rst.Fields("BR20") = arr1(i, 19)
rst.Fields("BR21") = arr1(i, 20)
rst.Fields("BR22") = arr1(i, 21)
rst.Fields("BR23") = arr1(i, 22)
rst.Fields("BR24") = arr1(i, 23)
rst.Fields("BR25") = arr1(i, 24)
rst.Fields("BR26") = arr1(i, 25)
rst.Fields("BR27") = arr1(i, 26)
rst.Fields("BR28") = arr1(i, 27)
rst.Fields("BR29") = arr1(i, 28)
rst.Fields("BR30") = arr1(i, 29)
rst.Fields("BR31") = arr1(i, 30)
rst.Fields("BR32") = arr1(i, 31)
rst.Fields("BR33") = arr1(i, 32)
rst.Fields("BR34") = arr1(i, 33)
rst.Fields("BR35") = arr1(i, 34)
rst.Fields("BR36") = arr1(i, 35)
rst.Fields("BR37") = arr1(i, 36)
rst.Fields("BR38") = arr1(i, 37)
rst.Fields("BR39") = arr1(i, 38)
rst.Fields("BR40") = arr1(i, 39)
rst.Fields("BR41") = arr1(i, 40)
rst.Fields("BR42") = arr1(i, 41)
rst.Fields("BR43") = arr1(i, 42)
rst.Fields("BR44") = arr1(i, 43)
rst.Fields("BR45") = arr1(i, 44)
rst.Fields("BR46") = arr1(i, 45)
rst.Fields("BR47") = arr1(i, 46)
rst.Fields("BR48") = arr1(i, 47)
rst.Fields("BR49") = arr1(i, 48)
rst.Fields("BR50") = arr1(i, 49)
rst.Fields("BR51") = arr1(i, 50)
rst.Fields("BR52") = arr1(i, 51)
rst.Fields("BR53") = arr1(i, 51)
rst.Fields("BR54") = arr1(i, 53)
rst.Fields("BR55") = arr1(i, 54)
rst.Fields("BR56") = arr1(i, 55)
rst.Fields("BR57") = arr1(i, 56)
rst.Fields("BR58") = arr1(i, 57)
rst.Fields("BR59") = arr1(i, 58)
rst.Fields("BR60") = arr1(i, 59)
rst.Fields("BR61") = arr1(i, 60)
rst.Fields("BR62") = arr1(i, 61)
rst.Fields("BR63") = arr1(i, 62)
rst.Fields("BR64") = arr1(i, 63)
rst.Fields("BR65") = arr1(i, 64)
rst.Fields("BR66") = arr1(i, 65)
rst.Fields("BR67") = arr1(i, 66)
rst.Fields("BR68") = arr1(i, 67)
rst.Fields("BR69") = arr1(i, 68)
End If
Next i
rst.Update
cnn.Close
Set cnn = Nothing
End Sub
1.rar
(35.58 KB, 下载次数: 7)
[ 本帖最后由 zhtvnet 于 2008-12-17 09:38 编辑 ] |
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2008-12-13 18:33
发表于 2008-12-13 19:37
楼主