我也刚学会的,希望可以帮到你~
Private Sub Command1_Click()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim xlapp As Excel.Application
Dim xlbook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
On Error GoTo 10
Set xlapp = New Excel.Application
Set xlbook = xlapp.Workbooks.Open("D:\excel\book1.xls")
Set xlsheet = xlbook.Worksheets("sheet1")
If xlsheet.Cells(1, 1) = "姓名" And xlsheet.Cells(1, 2) = "学号" And xlsheet.Cells(1, 3) = "语文" And xlsheet.Cells(1, 4) = "物理" _
And xlsheet.Cells(1, 5) = "数学" And xlsheet.Cells(1, 6) = "英语" Then
X = 2
cn.Open "Provider=MSDASQL.1;Driver=Microsoft Visual Foxpro Driver;SourceDB=D:\student\;SourceType=DBF"
rs.Open "select * from TYPE1 ", cn, adOpenKeyset, adLockOptimistic
Do While xlsheet.Cells(X, 1) <> ""
rs.AddNew
rs.Fields("姓名") = xlsheet.Cells(X, 1)
rs.Fields("学号") = xlsheet.Cells(X, 2)
rs.Fields("语文") = xlsheet.Cells(X, 3)
rs.Fields("物理") = xlsheet.Cells(X, 4)
rs.Fields("数学") = xlsheet.Cells(X, 5)
rs.Fields("英语") = xlsheet.Cells(X, 6)
rs.Update
End If
X = X + 1
Loop
rs.Close
cn.Close
Else
GoTo 10
End If
xlbook.Close False
xlapp.Quit
Set xlapp = Nothing
MsgBox "数据导入成功!", vbOKOnly + 48, "信息"
Exit Sub
10: MsgBox "导入数据出错,请检查文本!", vbOKOnly + 48, "信息": xlapp.Quit
xlapp.Quit
End Sub