📄 数据库_通用fd.frm
字号:
End
Begin VB.Label lblAll
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "文件的总行数："
ForeColor = &H80000008&
Height = 255
Left = 240
TabIndex = 6
Top = 3360
Width = 1335
End
Begin VB.Label lblRowNumber
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
ForeColor = &H80000008&
Height = 255
Left = 1560
TabIndex = 5
Top = 2880
Width = 615
End
Begin VB.Label lblRow
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "文件的行数："
ForeColor = &H80000008&
Height = 255
Left = 120
TabIndex = 4
Top = 2880
Width = 1455
End
Begin VB.Label lblColNumber
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
ForeColor = &H80000008&
Height = 255
Left = 1560
TabIndex = 3
Top = 2400
Width = 615
End
Begin VB.Label lblCol
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "文件的列数："
ForeColor = &H80000008&
Height = 255
Left = 120
TabIndex = 2
Top = 2400
Width = 1455
End
Begin VB.Label lblBaseName
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "数据文件全名"
ForeColor = &H80000008&
Height = 255
Left = 1320
TabIndex = 0
Top = 720
Width = 1935
End
End
Attribute VB_Name = "frmFileData"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'frmFileData窗体
'从数据文件变换为数据库
Option Explicit
Dim intI As Integer, intJ As Integer
'获取数据文件名
Private Sub Form_Load()
lblCol.Visible = False
lblRow.Visible = False
lblAll.Visible = False
lblColNumber.Visible = False
lblRowNumber.Visible = False
lblAllNumber.Visible = False
lblNote1.Visible = False
lblNote2.Visible = False
cmdOK2.Visible = False
Me.Width = 4800
With CommonDialog1
.DialogTitle = "提供数据文件名" '设置对话框标题
.DefaultExt = ".dat" '缺省的文件扩展名
.Filter = "所有文件(*.*)|*.*|数据文件(*.dat)|*.dat"
.FilterIndex = 2 '缺省的过滤器为第2个即“数据文件”
'设置“不显示在对话框下方的只读复选框”和“拒绝选择只读文件或有写保护的文件
.Flags = cdlOFNHideReadOnly Or cdlOFNNoReadOnlyReturn
End With
CommonDialog1.ShowOpen '显示公共对话框
'由公共对话框取得文件名
txtFileName = CommonDialog1.FileName
End Sub
'取得数据文件后，下一步需要取得数据文件的参数
Private Sub cmdOK1_Click()
Dim vntA, intI As Integer, intJ As Integer
'使与数据文件有关的标签和命令按钮可视
lblCol.Visible = True
lblRow.Visible = True
lblAll.Visible = True
lblColNumber.Visible = True
lblRowNumber.Visible = True
lblAllNumber.Visible = True
lblNote1.Visible = True
lblNote2.Visible = True
cmdOK2.Visible = True
strFileName = txtFileName.Text
'从数据文件中得到列数（字段数）和行数（记录数）
intFileNumber = FreeFile '取得文件号码
Open strFileName For Input As intFileNumber '打开文件
Input #intFileNumber, vntA '读列数
intCol = vntA
lblColNumber = intCol '在标签中显示列数
For intJ = 2 To intCol '读*******
Input #intFileNumber, vntA
Next intJ
Input #intFileNumber, vntA '读行数
intRow = vntA
lblRowNumber = intRow '在标签中显示行数
For intJ = 2 To intCol '读*******
Input #intFileNumber, vntA
Next intJ
Input #intFileNumber, vntA '读总行数
intRowAll = vntA
lblAllNumber = intRowAll '在标签中显示总行数
For intJ = 2 To intCol '读*******
Input #intFileNumber, vntA
Next intJ
Close #intFileNumber
blnTitle = False: blnRowLabel = False: blnColLabel = False
'优先考虑图题
'加3的意思是加列数、行数、总行数
If intRowAll > intRow + 3 Then blnTitle = True
'其次考虑行标
'行标共有intRow个
If intRowAll > 2 * intRow Then blnRowLabel = True
'最后考虑列标
'加5的意思是除了加列数、行数、总行数外，还要加图题和列标
'列标（字段名）在2 * intRow + 5行（记录）
If intRowAll = 2 * intRow + 5 Then blnColLabel = True
'按行数和列数重新定义数组
ReDim dbArray(1 To intRowAll, 1 To intCol)
intFileNumber = FreeFile '取得文件号码
Open strFileName For Input As intFileNumber '打开文件
'读数据
For intI = 1 To intRowAll
For intJ = 1 To intCol
Input #intFileNumber, vntA
dbArray(intI, intJ) = vntA
Next intJ
Next intI
Close #intFileNumber
cmdOK1.Visible = False
End Sub
'完成数据文件的准备工作，开始转向数据库
Private Sub cmdOK2_Click()
Me.Width = 9600 '展开另一半窗体
'使与数据库有关的标签、文本框和命令按钮等暂时不可视
Drive1.Visible = False
Dir1.Visible = False
lblDrive.Visible = False
lblDir.Visible = False
lblDBName.Visible = False
lblTotal.Visible = False
lblTable.Visible = False
txtDB.Visible = False
txtTotal.Visible = False
txtTable.Visible = False
cmdChange.Visible = False
cmdOK2.Visible = False
End Sub
'确定是建新库，还是打开老数据库之后
Private Sub cmdOK3_Click()
On Error GoTo DBNameError
'使与数据库有关的标签、命令按钮可视
lblTotal.Visible = True
lblTable.Visible = True
txtTotal.Visible = True
txtTable.Visible = True
cmdChange.Visible = True
If Option1.Value Then '新建数据库
'使与建新库有关的命令按钮、文本框和标签可视
Drive1.Visible = True
Dir1.Visible = True
lblDrive.Visible = True
lblDir.Visible = True
lblDBName.Visible = True
txtDB.Visible = True
Else '打开数据库
With CommonDialog2
.DialogTitle = "提供数据库名"
.DefaultExt = "mdb" '以.mdb为扩展名,缺省
.Filter = "(*.mdb)|*.mdb"
.CancelError = True '按"取消"则作为错误
.ShowOpen '打开已有的数据库
txtTotal.Text = .FileName '数据库全名
End With
End If
cmdOK3.Visible = False
txtTable.SetFocus '提供数据表名的文本框获得焦点
Exit Sub
DBNameError:
strDBName = ""
MsgBox "数据名错误", , "数据库"
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
Private Sub txtDB_Change()
txtTotal.Text = Dir1.Path & "\" & txtDB.Text & ".mdb"
End Sub
Private Sub cmdChange_Click()
strDBName = txtTotal.Text '数据库名
strTDName = txtTable.Text '数据表名
If Option1.Value Then '新建数据库
Set db = DBEngine(0).CreateDatabase(strDBName, dbLangGeneral)
Else '打开数据库
Set db = DBEngine(0).OpenDatabase(strDBName)
End If
strTDName = txtTable.Text '数据表名
'新建数据表
Set td = db.CreateTableDef(strTDName)
For intI = 1 To intCol
'建立字段
Set fd = td.CreateField(dbArray(intRow + 5, intI), dbText, 20)
td.Fields.Append fd '将字段添加到数据表
Next intI
db.TableDefs.Append td
Set rs = td.OpenRecordset(dbOpenDynaset)
For intI = intRow + 6 To intRowAll
rs.AddNew
For intJ = 1 To intCol
rs(intJ - 1) = dbArray(intI, intJ)
Next intJ
rs.Update
Next intI
Close #intFileNumber
lblEnd.Visible = True
End Sub
'退出
Private Sub lblEnd_Click()
Unload Me
frmDatabase.Show
End Sub
'退出
Private Sub cmdExit_Click()
Unload Me
frmDatabase.Show
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -