Option Explicit
Dim db As Database '定义一个DAO数据库对象
Dim strtable As String '指定Access数据库中的表名
' Export the file.
Private Sub cmdExport_Click()
Dim fnum As Integer
Dim file_name As String
Dim database_name As StringDim rs As Recordset
Dim num_fields As Integer
Dim field_width() As Integer
Dim field_value As String
Dim i As Integer
Dim num_processed As IntegerOn Error GoTo MiscError
' Open the output file.
fnum = FreeFile
file_name = txtFileName.Text
Open file_name For Append As fnum
strtable = List1.Text
Set rs = db.OpenRecordset("SELECT * FROM " & strtable)
'把数据库中表的字段名称导出到文本文件中
num_fields = rs.Fields.Count
ReDim field_width(0 To num_fields - 1)
For i = 0 To num_fields - 1 field_width(i) = rs.Fields(i).Size
If field_width(i) < Len(rs.Fields(i).Name) Then
field_width(i) = Len(rs.Fields(i).Name)
End If
field_width(i) = field_width(i) + 1
Print #fnum, rs.Fields(i).Name;
Print #fnum, Space$(field_width(i) - _
Len(rs.Fields(i).Name));
Next i
Print #fnum, ""
' 把数据库表中数据按记录导出到文本文件中
Do While Not rs.EOF
num_processed = num_processed + 1
For i = 0 To num_fields - 1
field_value = rs.Fields(i).Value
Print #fnum, field_value & _
Space$(Abs(field_width(i) - _
Len(field_value)));
Next i
Print #fnum, ""
rs.MoveNext
Loop
' Close the file and database.
rs.Close
db.Close
Close fnum
MsgBox "Processed " & _
Format$(num_processed) & " records."
Exit Sub
MiscError:
MsgBox "Error " & Err.Number & _
vbCrLf & Err.Description
End SubPrivate Sub Command1_Click()
CommonDialog1.Filter = "数据库文件(*.mdb)|*.mdb"
CommonDialog1.ShowOpen
txtDatabaseName.Text = CommonDialog1.FileName
End SubPrivate Sub Command2_Click()
CommonDialog1.Filter = "文本文件(*.txt)|*.txt"
CommonDialog1.ShowOpen
txtFileName.Text = CommonDialog1.FileName
End SubPrivate Sub Command3_Click()
' 打开数据库并且把数据库中的表名显示在列表框中
Set db = OpenDatabase(txtDatabaseName.Text)
RefreshListEnd SubPrivate Sub Form_Load()
txtDatabaseName.Text = App.Path & "\15.mdb"
txtFileName.Text = App.Path & "\15.txt"
End Sub
Private Sub RefreshList() '刷新List1的内容
Dim i As Integer
List1.Clear
For i = db.TableDefs.Count - 1 To 0 Step -1
If db.TableDefs(i).Attributes = 0 Then
List1.AddItem (db.TableDefs(i).Name)
End If
Next
End Sub
Dim db As Database '定义一个DAO数据库对象
Dim strtable As String '指定Access数据库中的表名
' Export the file.
Private Sub cmdExport_Click()
Dim fnum As Integer
Dim file_name As String
Dim database_name As StringDim rs As Recordset
Dim num_fields As Integer
Dim field_width() As Integer
Dim field_value As String
Dim i As Integer
Dim num_processed As IntegerOn Error GoTo MiscError
' Open the output file.
fnum = FreeFile
file_name = txtFileName.Text
Open file_name For Append As fnum
strtable = List1.Text
Set rs = db.OpenRecordset("SELECT * FROM " & strtable)
'把数据库中表的字段名称导出到文本文件中
num_fields = rs.Fields.Count
ReDim field_width(0 To num_fields - 1)
For i = 0 To num_fields - 1 field_width(i) = rs.Fields(i).Size
If field_width(i) < Len(rs.Fields(i).Name) Then
field_width(i) = Len(rs.Fields(i).Name)
End If
field_width(i) = field_width(i) + 1
Print #fnum, rs.Fields(i).Name;
Print #fnum, Space$(field_width(i) - _
Len(rs.Fields(i).Name));
Next i
Print #fnum, ""
' 把数据库表中数据按记录导出到文本文件中
Do While Not rs.EOF
num_processed = num_processed + 1
For i = 0 To num_fields - 1
field_value = rs.Fields(i).Value
Print #fnum, field_value & _
Space$(Abs(field_width(i) - _
Len(field_value)));
Next i
Print #fnum, ""
rs.MoveNext
Loop
' Close the file and database.
rs.Close
db.Close
Close fnum
MsgBox "Processed " & _
Format$(num_processed) & " records."
Exit Sub
MiscError:
MsgBox "Error " & Err.Number & _
vbCrLf & Err.Description
End SubPrivate Sub Command1_Click()
CommonDialog1.Filter = "数据库文件(*.mdb)|*.mdb"
CommonDialog1.ShowOpen
txtDatabaseName.Text = CommonDialog1.FileName
End SubPrivate Sub Command2_Click()
CommonDialog1.Filter = "文本文件(*.txt)|*.txt"
CommonDialog1.ShowOpen
txtFileName.Text = CommonDialog1.FileName
End SubPrivate Sub Command3_Click()
' 打开数据库并且把数据库中的表名显示在列表框中
Set db = OpenDatabase(txtDatabaseName.Text)
RefreshListEnd SubPrivate Sub Form_Load()
txtDatabaseName.Text = App.Path & "\15.mdb"
txtFileName.Text = App.Path & "\15.txt"
End Sub
Private Sub RefreshList() '刷新List1的内容
Dim i As Integer
List1.Clear
For i = db.TableDefs.Count - 1 To 0 Step -1
If db.TableDefs(i).Attributes = 0 Then
List1.AddItem (db.TableDefs(i).Name)
End If
Next
End Sub
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货