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 = "这个数据库已加密,请输入密码:"
Comm1.FileName = "*.mdb;*.dbf"
Comm1.Filter = "*.mdb"
Comm1.DialogTitle = "打开数据库文件"
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
'创建word应用程序，这一句话打开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
'指定表格内容
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
