Dim ws As Workspace, db As Database, tb As TableDef, rs As Recordset
Dim nn As Long, errS As String
Dim Errstring As String
Private Sub Form_Load()
  Data1.DatabaseName = App.Path & "\db.mdb"
  Text1.Text = Data1.DatabaseName
End Sub
Private Sub Command3_Click()
  Dim filen As String, dirf As String, mm As String
  mm = ""
  Errstring = "這個數(shù)據(jù)庫已加密,請輸入密碼:"
  Comm1.FileName = "*.mdb;*.dbf"
  Comm1.Filter = "*.mdb"
  Comm1.DialogTitle = "打開數(shù)據(jù)庫文件"
  Comm1.ShowOpen
  filen = LCase(Comm1.FileName)
  For i = Len(filen) To 1 Step -1
      dirf = Mid(filen, i, 1)
      If dirf = "\" Then
         dirf = Left(filen, i)
         Exit For
      End If
  Next
  If filen <> "*.mdb;*.dbf" Then
     List1.Clear
     Set ws = DBEngine.Workspaces(0)
     If Right(filen, 3) = "mdb" Then
        Set db = ws.OpenDatabase(filen, False, False, ";pwd=" & mm)
      Else
        Set db = ws.OpenDatabase(dirf, False, False, "FoxPro 2.6")
     End If
  End If
  For Each tb In db.TableDefs
     If Left(tb.Name, 4) <> "MSys" Then List1.AddItem (tb.Name)
  Next
  List1.Refresh
  Text1.Text = Comm1.FileName
End Sub
Private Sub Command1_Click()
  Dim i As Integer, j As Integer
  Dim ifieldcount As Integer, irecordcount As Integer
  Dim wdapp As Word.Application
  Dim wddoc As Word.Document
  Dim atable As Word.Table
  With Data1.Recordset
       Data1.Recordset.MoveLast
       Data1.Recordset.MoveFirst
       ifieldcount = .Fields.Count
       irecordcount = .RecordCount
  End With
  On Error Resume Next
  '創(chuàng)建word應(yīng)用程序，這一句話打開word2000
  Set wdapp = CreateObject("Word.Application")
  '在word中添加一個新文檔
  Set wddoc = wdapp.Documents.Add
  With wdapp
  .Visible = True
  .Activate
  '在word中增加一個表格
  Set atable = .ActiveDocument.Tables.Add(.Selection.Range, irecordcount + 1, ifieldcount)
  For i = 0 To ifieldcount - 1
      atable.Cell(1, i + 1).Range.InsertAfter DBGrid1.Columns(i)
  Next i
  '指定表格內(nèi)容
  For i = 0 To irecordcount - 1
  For j = 0 To ifieldcount - 1
      DBGrid1.Row = i
      DBGrid1.Col = j
      atable.Cell(i + 2, j + 1).Range.InsertAfter DBGrid1.Text
  Next j
  Next i
  End With
  '清除word對象
  Set wdapp = Nothing
  Set wddoc = Nothing
End Sub

Private Sub List1_Click()
  Data1.DatabaseName = Text1.Text
  Data1.RecordSource = List1.Text
  Data1.Refresh
  DBGrid1.Refresh
End Sub
Private Sub Command2_Click()
  End
End Sub