程序代码：

Dim str As String

Private Sub Command1_Click()

Me.CommonDialog1.ShowOpen
str = Me.CommonDialog1.FileName
Text1.Text = str
End Sub

Private Sub Command2_Click()

Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
right1 = Right(str, 3)
If LCase(right1) <> "dbf" Then
MsgBox "不能识别该文件，请选择正确的表进行导入"
Else
cn.ConnectionString = "Provider=msdasql;DRIVER=microsoft visual foxpro driver;uid=;deleted=yes;null=no;backgroundfetch=no;exclusive=no;sourcetype=dbf;sourcedb=" & str & ""
cn.Open
sql = "select * from'" & str & "'"
Set rs = cn.Execute(sql)
cn.Close
Set cn1 = New ADODB.Connection
Set rs1 = New ADODB.Recordset

cn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Users\Administrator\Desktop\ddc\file.mdb;Persist Security Info=False"
sql1 = "select* from student"
rs1.Open sql1, cn1, 3, 2
cn.Open
rs.Open sql, cn, 1, 1
Do While rs.EOF <> True

 rs1.AddNew

 rs1!sno = rs!sno

 rs1!sname = rs!sname

 rs1!ssex = rs!ssex

 rs1!sage = rs!sage

 rs1!sdept = rs!sdept

 rs1.Update

 rs.MoveNext

 Loop

 MsgBox "导入成功"

 End If

 cn.Close

 Me.Adodc1.Refresh

 Me.DataGrid1.Refresh
End Sub