崩溃,为什么我照着斑竹的做,是错的,EXCEL导入ACCESS某一列

jiangdibodanny

Private Sub ComboBox1_dropbuttonclick()
ComboBox1.Font.Size = 15
ComboBox2.Font.Size = 15

ComboBox1.Height = 22
ComboBox1.Width = 75
ComboBox2.Height = 22
ComboBox2.Width = 75
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim mypath As String, mytable As String
mypath = ThisWorkbook.Path & "\database5.ACCDb"

cnn.Open "provider=Microsoft.ACE.OLEDB.12.0;Data source=" & mypath

Dim i As Integer
With rst
   For i = 2 To rst.Fields.Count - 11
         If ComboBox1.ListCount < rst.Fields.Count - 10 Then
              ComboBox1.AddItem rst.Fields(i).Name
            Else
         
         Exit Sub
         End If
   Next i
End With

End Sub


Private Sub ComboBox1_Change()
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim mypath As String, mytable As String
mypath = ThisWorkbook.Path & "\database5.ACCDb"

cnn.Open "provider=Microsoft.ACE.OLEDB.12.0;Data source=" & mypath
With rst
Dim j, m As Integer
     For j = 1 To rst.Fields.Count - 10
        If ComboBox1.Text = rst.Fields(j).Name Then
           ComboBox2.Text = rst.Fields(j + 10).Name
               For m = 1 To 10
                  Sheet5.Cells(12, 1 + m).Value = rst.Fields(j + m - 1).Name
                Next m
        End If
     Next j
End With
End Sub

jiangdibodanny

这段程序如果用ADODC控件就能实现COMBOBOX加选项,同时在2上显示第十个字段的选项,但是变成对象就不行了

zhaogang1960

jiangdibodanny 发表于 2013-12-5 16:20
一样的,数据库还是1楼的那个

一、程序所在工作簿是哪一个，数据源是哪一个？
二、以哪个字段为准，更新哪个字段？

jiangdibodanny

我想实现的目标是:
    1,   程序的COMBOBOX控件绑定数据库的字段名,使控件能显示字段名便于选择,  第二个控件显示的是第一个控件里按顺序第10个字段名
       并且在当前页的单元格按顺序输出从  COMBOBOX1 到COMBOBOX2中的10个字段名
   2,  工作薄是SHEET1,  数据库就是DATABASE5

zhaogang1960

jiangdibodanny 发表于 2013-12-5 19:08
我想实现的目标是:
    1,   程序的COMBOBOX控件绑定数据库的字段名,使控件能显示字段名便于选择,  第二个 ...

首先本例属于更新，即update，要有一个基准字段，1楼是ID字段
这个附件没有说明这个基准字段是哪一个，要更新哪个，或哪几个字段

jiangdibodanny

除了第一个字段,从第二个字段开始

jiangdibodanny

不用UPDATE,这里只是控件选项加上就行了

jiangdibodanny

jiangdibodanny 发表于 2013-12-5 19:49
不用UPDATE,这里只是控件选项加上就行了

没事,老师您方便时候写

zhaogang1960

jiangdibodanny 发表于 2013-12-5 20:25
没事,老师您方便时候写

问题比想象的要复杂的多：
一要判断第一个字段测量点(数据库中不允许重复)数据库中是否存在，如果存在则更新改行数据；如果不存在则添加新记录

zhaogang1960

请测试：

1. Private Sub ComboBox1_DropButtonClick()
   
2.     ComboBox1.Column = Range("A9", Cells(9, Columns.Count).End(1)).Value
   
3. End Sub
   
4. 
   
5. Private Sub ComboBox2_DropButtonClick()
   
6.     ComboBox2.Column = Range("A9", Cells(9, Columns.Count).End(1)).Value
   
7. End Sub
   
8. 
   
9. Private Sub CommandButton1_Click()
   
10. '引用Microsoft ActiveX Data Objects 2.x Library
    
11.     Dim cnn As New ADODB.Connection
    
12.     Dim rs As New ADODB.Recordset
    
13.     Dim SQL As String
    
14.     Dim myPath As String
    
15.     Dim myTable As String
    
16.     Dim UpdateFields As String
    
17.     Dim AddFields As String
    
18.     Dim arrFields As Variant
    
19.    
    
20.     If ComboBox1.ListIndex < 1 Then
    
21.         MsgBox "请选择测量点后面的字段！", vbCritical
    
22.         Exit Sub
    
23.     End If
    
24.     If ComboBox2.ListIndex <= ComboBox1.ListIndex Then
    
25.         MsgBox "请选择第一个复合框后面的字段！", vbCritical
    
26.         Exit Sub
    
27.     End If
    
28.    
    
29.     myPath = ThisWorkbook.Path & "\Database5.accdb"
    
30.     myTable = "BX5A"
    
31.    
    
32.     On Error GoTo errmsg
    
33.     cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & myPath '连接数据库
    
34.     arrFields = Range("A9", Cells(9, Columns.Count).End(1)) '工作表中的字段名写入数组
    
35.    
    
36.     '生成更新字符串，添加字符串AddFields
    
37.     For i = ComboBox1.ListIndex + 1 To ComboBox2.ListIndex + 1
    
38.         UpdateFields = UpdateFields & ",a." & arrFields(1, i) & "=b." & arrFields(1, i)
    
39.         AddFields = AddFields & ",a." & arrFields(1, i)
    
40.     Next
    
41.    
    
42.     SQL = "update " & myTable & " a,[Excel 12.0;imex=0;Database=" & ActiveWorkbook.FullName & "].[Sheet1$" _
    
43.         & Range("a9").CurrentRegion.Address(0, 0) & "] b set " & Mid(UpdateFields, 2) & " where a.测量点=b.测量点"
    
44.     cnn.Execute SQL '不判断，更新可能存在的“测量点”
    
45. 
    
46.     '生成数据库不存在记录的SQL语句
    
47.     SQL = "select a.测量点" & AddFields & " from [Excel 12.0;Database=" & ActiveWorkbook.FullName & "].[Sheet1$" & Range("a9").CurrentRegion.Address(0, 0) _
    
48.         & "] a left join " & myTable & " b on a.测量点=b.测量点 where b.测量点 is null"
    
49.     Set rs = New ADODB.Recordset
    
50.     rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
    
51. 
    
52.     '插入数据库不存在记录
    
53.     If rs.RecordCount > 0 Then '如果工作表中含有数据库不存在记录
    
54.         SQL = "insert into " & myTable & " " & SQL '插入新记录SQL语句
    
55.         cnn.Execute SQL
    
56.         MsgBox rs.RecordCount & "行数据已经添加到数据库！", vbInformation, "添加数据"
    
57.     End If
    
58. 
    
59.     '关闭连接释放内存
    
60.     rs.Close
    
61.     cnn.Close
    
62.     Set rs = Nothing
    
63.     Set cnn = Nothing
    
64.     Exit Sub
    
65. errmsg:
    
66.     MsgBox Err.Description, , "错误报告"
    
67. End Sub
    

复制代码