frmmain.frm

VB代码

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmMain 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "导出数据库的内容"
   ClientHeight    =   1815
   ClientLeft      =   1125
   ClientTop       =   1500
   ClientWidth     =   6165
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   1815
   ScaleWidth      =   6165
   Begin MSComDlg.CommonDialog dlgShow 
      Left            =   600
      Top             =   840
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton cmdOpen 
      Caption         =   "选择数据库(&D)"
      Height          =   495
      Left            =   1440
      TabIndex        =   3
      Top             =   960
      Width           =   1575
   End
   Begin VB.TextBox txtDatabaseName 
      Height          =   285
      Left            =   1200
      Locked          =   -1  'True
      TabIndex        =   2
      Top             =   360
      Width           =   4695
   End
   Begin VB.CommandButton cmdExport 
      Caption         =   "导出数据库(&E)"
      Height          =   495
      Left            =   3600
      TabIndex        =   1
      Top             =   960
      Width           =   1575
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "数据库文件："
      Height          =   180
      Index           =   0
      Left            =   120
      TabIndex        =   0
      Top             =   412
      Width           =   1080
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmdExport_Click()
   If txtDatabaseName.Text = "" Then Exit Sub
   On Error GoTo errHandler
   
   Dim db As Database
   Dim tbl As TableDef
   Dim strFile As String
   '打开数据库
   Set db = OpenDatabase(txtDatabaseName.Text)
   Dim fso As New FileSystemObject
   strFile = fso.GetBaseName(db.Name)  ''取得数据库的文件名
   strFile = fso.BuildPath(fso.GetParentFolderName(db.Name), strFile)
   
   Dim str As String
   ''遍历整个数据库中的所有的表，并将其导入到相应的文件中
   For Each tbl In db.TableDefs
      If (tbl.Attributes And dbSystemObject) = 0 Then '排除系统表
         str = strFile & "_" & tbl.Name & ".dat" '形成一个表对应的文件名
         ExportTable tbl, str
      End If
   Next tbl

   db.Close    '关闭数据库
   Reset ''关闭所有打开的文件
   
   MsgBox "导出数据库成功！", vbInformation, "成功"
   Exit Sub
   
errHandler:
   MsgBox Err.Description, vbCritical, "错误"
End Sub

'调用该函数来将一个TableDef对象中的内容输出到另一个文件
Private Sub ExportTable(tblSource As TableDef, strFileName As String)
   On Error Resume Next
   
   ''从TableDef对象中生成一个记录集
   Dim rs As Recordset
   '由于在读取数据时，只需要向前浏览，故打开类型为ForwardOnly的记录集，以取得好的性能。
   Set rs = tblSource.OpenRecordset(dbOpenForwardOnly, dbForwardOnly)
   
   Dim nFields As Integer  '表中的字段的数量
   Dim arrFieldWidth() As Integer  '用来存储各个字段的长度的可变数组
   Dim strFieldValue As String     '用来存储字段的值
   
   Dim nFileNumber As Integer  '文件号
   nFileNumber = FreeFile()
   Open strFileName For Output As nFileNumber '打开文件
   '在文本文件中打印当前表的记录
   nFields = rs.Fields.Count
   ReDim arrFieldWidth(0 To nFields - 1)
   Dim i As Integer
   For i = 0 To nFields - 1
      arrFieldWidth(i) = rs.Fields(i).Size
      If arrFieldWidth(i) < Len(rs.Fields(i).Name) Then
          arrFieldWidth(i) = Len(rs.Fields(i).Name)
      End If
      arrFieldWidth(i) = arrFieldWidth(i) + 1
      Print #nFileNumber, rs.Fields(i).Name;
      Print #nFileNumber, Space$(arrFieldWidth(i) - Len(rs.Fields(i).Name));
   Next i
   Print #nFileNumber, ""
   
   '向文件中打印出记录集内容
   Do While Not rs.EOF
      For i = 0 To nFields - 1
          strFieldValue = rs.Fields(i).Value
          Print #nFileNumber, strFieldValue & Space$(arrFieldWidth(i) - Len(strFieldValue));
      Next i
      Print #nFileNumber, ""
      rs.MoveNext
   Loop
   
   rs.Close          '关闭所打开的记录集
   Close nFileNumber '关闭所打开的文件
End Sub

Private Sub cmdOpen_Click()
   dlgShow.InitDir = App.Path
   dlgShow.Filter = "Access文件（*.mdb）|*.mdb"
   dlgShow.ShowOpen
   
   If dlgShow.FileName <> "" Then txtDatabaseName.Text = dlgShow.FileName
End Sub