www.pudn.com > d019_xlstomdb.zip > Form1.frm

VERSION 5.00 
Begin VB.Form Form1  
   Caption         =   "Form1" 
   ClientHeight    =   1590 
   ClientLeft      =   60 
   ClientTop       =   345 
   ClientWidth     =   5760 
   LinkTopic       =   "Form1" 
   ScaleHeight     =   1590 
   ScaleWidth      =   5760 
   StartUpPosition =   3  '´°¿Úȱʡ 
   Begin VB.TextBox txtAccessFile  
      Height          =   285 
      Left            =   1560 
      TabIndex        =   3 
      Top             =   480 
      Width           =   4095 
   End 
   Begin VB.CommandButton cmdLoad  
      Caption         =   "Load Data" 
      Default         =   -1  'True 
      Height          =   495 
      Left            =   2280 
      TabIndex        =   2 
      Top             =   960 
      Width           =   1215 
   End 
   Begin VB.TextBox txtExcelFile  
      Height          =   285 
      Left            =   1560 
      TabIndex        =   1 
      Top             =   120 
      Width           =   4095 
   End 
   Begin VB.Label Label1  
      Caption         =   "Access Database" 
      Height          =   255 
      Index           =   1 
      Left            =   120 
      TabIndex        =   4 
      Top             =   480 
      Width           =   1335 
   End 
   Begin VB.Label Label1  
      Caption         =   "Excel Spreadsheet" 
      Height          =   255 
      Index           =   0 
      Left            =   120 
      TabIndex        =   0 
      Top             =   120 
      Width           =   1335 
   End 
End 
Attribute VB_Name = "Form1" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
'download at: http://vb.cn99.com 
 
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 
 
    ' Create the Excel application. 
    Set excel_app = CreateObject("Excel.Application") 
 
    ' Uncomment this line to make Excel visible. 
'    excel_app.Visible = True 
 
    ' Open the Excel spreadsheet. 
    excel_app.Workbooks.Open FileName:=txtExcelFile.Text 
 
    ' Check for later versions. 
    If Val(excel_app.Application.Version) >= 8 Then 
        Set excel_sheet = excel_app.ActiveSheet 
    Else 
        Set excel_sheet = excel_app 
    End If 
 
    ' Open the Access database. 
    Set db = OpenDatabase(txtAccessFile.Text) 
 
    ' Get data from the Excel spreadsheet and insert 
    ' it into the TestValues table. 
    row = 1 
    Do 
        ' Get the next value. 
        new_value = Trim$(excel_sheet.Cells(row, 1)) 
 
        ' See if it's blank. 
        If Len(new_value) = 0 Then Exit Do 
 
        ' Insert the value into the database. 
        db.Execute "INSERT INTO TestValues VALUES (" & _ 
            new_value & ")" 
 
        row = row + 1 
    Loop 
 
    ' Close the database. 
    db.Close 
    Set db = Nothing 
 
    ' Comment the rest of the lines to keep 
    ' Excel running so you can see it. 
 
    ' Close the workbook without saving. 
    excel_app.ActiveWorkbook.Close False 
 
    ' Close Excel. 
    excel_app.Quit 
    Set excel_sheet = Nothing 
    Set excel_app = Nothing 
 
    Screen.MousePointer = vbDefault 
    MsgBox "Copied " & Format$(row - 1) & " values." 
End Sub 
 
' Note that this project contains a reference to 
' Microsoft DAO 3.51 Object Library. 
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