form1.frm

使用VB创建ACCESS数据库

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3090
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3090
   ScaleWidth      =   4680
   StartUpPosition =   3  '窗口缺省
   Begin MSComDlg.CommonDialog dlgCommonDialog 
      Left            =   1320
      Top             =   1200
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton Command1 
      Caption         =   "创建数据库"
      Height          =   375
      Left            =   2400
      TabIndex        =   0
      Top             =   2400
      Width           =   1815
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
Dim e
Dim objCatalog As New ADOX.Catalog
Dim objTable As New ADOX.Table, objColumn As New ADOX.Column
Dim strFile As String, strTable As String
Dim LFileName As String
 With dlgCommonDialog
        .DialogTitle = "保存实验记录"
        .InitDir = App.Path & "\MyFlies\"
        .Filter = "实验文件(*.mdb)|*.mdb"
        .FileName = ""
        .CancelError = False
     Do While .FileName = ""
             .ShowSave
            LFileName = .FileName
        If UCase(Dir(LFileName)) <> "" Then
        If Len(LFileName) = 0 Then Exit Sub
            e = MsgBox(LFileName + "已经存在，是否覆盖？", 36, "保存")
            If e = vbNo Then .FileName = ""
         End If
     Loop
strFile = LFileName
strTable = "test"
objCatalog.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile
With objTable
    .Columns.Append "温度", adSingle
    .Columns.Append "压力", adSingle
    .Columns.Append "稠度", adSingle
    .Columns.Append "时间", adSingle
    .Name = strTable
End With
objCatalog.Tables.Append objTable
Set objColumn = Nothing
Set objTable = Nothing
Set objCatalog = Nothing
End With
MsgBox ("数据库创建完毕!")
End Sub