Private Sub into_Click() '导入
Dim sql As String
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim mycon As New ADODB.Connection
Dim yourRecord As New ADODB.RecordsetSet xlApp = CreateObject("Excel.Application") '创建EXCEL对象
Set xlBook = xlApp.Workbooks.Open("E:\backup.xls") '打开已经存在的EXCEL工件簿文件
xlApp.Visible = True '设置EXCEL对象可见(或不可见)
sql = jitaihao.Combo1.Text
Set xlSheet = xlBook.Worksheets(sql)      '设置活动工作表
If Val(xlApp.Application.Version) >= 8 Then
        Set xlSheet = xlApp.ActiveSheet
    Else
        Set xlSheet = xlApp
        
    End If
   
    mycon.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=\\10.10.0.250\图形流向\sclsylb.mdb;Persist Security Info=False"
    mycon.Open
  yourRecord.CursorLocation = adUseClient
    
     
    yourRecord.Open "select * from " + jitaihao.Combo1.Text + "", mycon, 2, 4     '打开记录集
 
   Dim v '导入记录,用了两层循环
  v = 1
  Do
  If Trim$(xlSheet.Cells(v, 1)) = "" Then Exit Do '外层,如果EXCEL表中读取到空行,结束
  yourRecord.AddNew
    
    Dim i As Integer
    Dim new_value As String
    For i = 1 To yourRecord.RecordCount
        ' Get the next value.
        new_value = Trim$(xlSheet.Cells(v, i))        ' See if it's blank.
        If Len(new_value) = 0 Then Exit Do
                ' Insert the value into the database.
        
        
       
     
     yourRecord.Fields(i) = new_value
     
    yourRecord.MoveNext
     
     Next i
     v = v + 1
    
        Loop
        yourRecord.Update
     xlApp.ActiveWorkbook.close False
    ' Close Excel.
    xlApp.Quit
    Set xlSheet = Nothing
    Set xlApp = Nothing
    
yourRecord.closeSet yourRecord = Nothing
MsgBox "导入成功", vbOKOnly, "提示"
End Sub