data15.dat

学习VB的经典资料 vb一点通 看后很快就会了 初学者的帮手

从Excel中读取数据到数据库

本程序可以从Excel中读取数据到Access数据库中。

Option Explicit

Private Sub cmdLoad_Click()
    Dim excel_app As Object
    Dim excel_sheet As Object
    Dim db As Database
    Dim new_value As String
    Dim row As Integer
    Screen.MousePointer = vbHourglass
    DoEvents
    '建立Excel application对象
    Set excel_app = CreateObject("Excel.Application")
    '打开指定的工作薄
    excel_app.Workbooks.Open FileName:=txtExcelFile.Text
    '判断版本
    If Val(excel_app.Application.Version) >= 8 Then
        Set excel_sheet = excel_app.ActiveSheet
    Else
        Set excel_sheet = excel_app
    End If
    '打开Access数据库
    Set db = OpenDatabase(txtAccessFile.Text)
    '删除表中原有记录
    db.Execute "delete from TestValues"
    ' 从Excel工作表中获取数据并插入到数据库的TestValues表中
    row = 1
    Do
        ' 得到工作表中的值
        new_value = Trim$(excel_sheet.Cells(row, 1))
        '如果某行空，则停止
        If Len(new_value) = 0 Then Exit Do
        '将获取的值插入到数据库的表TestValues中
        db.Execute "INSERT INTO TestValues VALUES (" & new_value & ")"
        '下一行
        row = row + 1
    Loop
    ' 关闭数据库
    db.Close
    '释放内存
    Set db = Nothing
    '关闭工作表，不重新保存
    excel_app.ActiveWorkbook.Close False
    '关闭Excel
    excel_app.Quit
    '释放内存
    Set excel_sheet = Nothing
    Set excel_app = Nothing
    '鼠标指针形状还原
    Screen.MousePointer = vbDefault
    '弹出提示框
    MsgBox "Copied " & Format$(row - 1) & " values.", , "Finished"
End Sub

Private Sub Form_Load()
    '初始化文件路径
    Dim file_path As String
    file_path = App.Path
    If Right$(file_path, 1) <> "\" Then file_path = file_path & "\"
    txtExcelFile.Text = file_path & "XlsToMdb.xls"
    txtAccessFile.Text = file_path & "XlsToMdb.mdb"
End Sub