,点击...那个按钮开始进行选择,实现方法如下:
DimstrTempAsString
strTemp=fBrowseForFolder(Me.hwnd,"Selectbackuppath")
IfstrTemp<>""Then
txtDestination=strTemp
EndIf
数据恢复界面同上,它的功能主要是在当前数据库遭到破坏后,可以利用它来进行数据恢复,在数据恢复前要选择所要恢复的数据库路径,如下:
DimstrTempAsString
strTemp=fBrowseForFolder(Me.hwnd,"RestoreFrom")
IfstrTemp<>""Then
txtSource=strTemp
dbasize2=FileLen(txtSource&"\db.MDB")
lblSelectedDba="SelectedBackupDatabaseis:"&Format((dbasize2/1024)/1024,"standard")&"MB."
cmdRestore.Enabled=True
EndIf
Erro:
SelectCaseerr.Number
Case53'FileNotFound
lblSelectedDba="NoBackupatthislocation"
Toolbar2.Enabled=False
EndSelect
它主要是查看数据库是否存在,如果所恢复的数据不存在,则会提示错误。
数据恢复也用到了一个方法,在模块中也已经定义了该方法DoRestore。数据恢复代码如下:
IfMsgBox("Restoringdatabasefromlocation"&txtSource&"willreplaceexistingdatabasefiles.DoyouwanttoContunue",vbYesNo)=vbYesThen
DoRestoretxtSource.Text,App.Path
IfNoDba=TrueThen
MsgBox"DatabaseRestoredClickOktoExitProgram"
frmRestoreDba.Hide
UnloadfrmRestoreDba
EndIf
Else
lblStatus.Caption="DatabaseRestoreCanceled"
EndIf
其中DoRestore实现的功能源码如下所示:
DEFSOURCE="PROVIDER=Microsoft.jet.oledb.4.0;PersistSecurityInfo=False;DataSource="
DBName="\db.MDB;JetOLEDB:DatabasePassword=matrix-se;"
SetDb=NewADODB.Connection
Db.OpenDEFSOURCE&App.Path&DBName
DimlFileOpAsLong
DimlresultAsLong
DimlFlagsAsLong
DimSHFileOpAsSHFILEOPSTRUCT
DimstrSourceDirAsString
DimstrDestinationDirAsString
Db.Close
Screen.MousePointer=vbHourglass
BackupFolderName=strDestinationPath
lFileOp=FO_COPY
lFlags=lFlagsAndNotFOF_SILENT
lFlags=lFlagsOrFOF_NOCONFIRMATION
lFlags=lFlagsOrFOF_NOCONFIRMMKDIR
lFlags=lFlagsOrFOF_FILESONLY
WithSHFileOp
.wFunc=lFileOp
.pFrom=strSourcePath&"\db.MDB"&vbNullChar
.pTo=strDestinationPath&vbNullChar
.fFlags=lFlags
EndWith
lresult=SHFileOperation(SHFileOp)
SetDb=NewADODB.Connection
Db.OpenDEFSOURCE&App.Path&DBName
Screen.MousePointer=vbDefault
frmRestoreDba.lblStatus="RestoreComplete"
说明:本程序中此部分内容参考了网上的同类型代码,对其进行修改后得到此成型作品,从功能上来讲,它已经实现了它所要完成的工作,经过测试已经没有问题,但是实现的源代码,也只有部分掌握。这实属本人精力与能力有限所置。
4.3.4数据转换
这个功能可以把当前列表框中的任何一个表转换成excel形式,转换后你可以看到表中的内容,也可以对表进行操作,保存,修改,打印等。
①界面效果图
图4.8数据转换效果图
②实现方法
在这里用到了一个显示gif图片的控件。选择左面list中的一个表后,点击导出后即可完成,进度条中显示当前转换进度程度。
首先要在list中加载各表名。以便进行选择转换。添加表名部分在load进行加载,其中的导出与取消按钮是由coolbar制作而成。
Form的load事件处理内容如下:
TMaxAni1.FileName=App.Path&"\icon\find.gif"
TMaxAni1.ShowGif
Dimcnn1AsADODB.Connection
DimrstschemaAsADODB.Recordset
DimstrcnnAsString
Setcnn1=NewADODB.Connection
strcnn="provider=Microsoft.jet.oledb.4.0;"&"datasource="&App.Path&"\db.mdb"
cnn1.Openstrcnn
Setrstschema=cnn1.OpenSchema(adSchemaTables)
DoUntilrstschema.EOF
temp=rstschema!Table_Name
IfLeft(temp,1)<>"M"Then
List2.AddItemtemp
EndIf
rstschema.MoveNext
Loop
cnn1.Close
List2.ListIndex=0
GoToerr
PathName=App.Path&"\db.MDB"
dbasize=FileLen(PathName)
数据转换成excel用到了一个部件,在引用中用到了MicrosoftExcel9.0Objectlibrary。转换代码如下:
SelectCaseButton.Index
Case1
DimproviderAsString
DimdatasourceAsString
provider="provider=Microsoft.jet.oledb.4.0"
datasource="datasource="&App.Path&"\DB.mdb"
WithAdodc1
.Mode=adModeReadWrite
.ConnectionString=provider&";"&datasource
.CommandType=adCmdTable
.RecordSource=List2.Text
.Refresh
EndWith
ProgressBar1.Max=Adodc1.Recordset.RecordCount
ProgressBar1.Min=0
'开始转换
DimIrow,IcolAsInteger
DimIrowcount,IcolcountAsInteger
DimFieldlen()
DimxlAppAsExcel.Application
DimxlBookAsExcel.Workbook
DimxlSheetAsExcel.Worksheet
SetxlApp=CreateObject("Excel.Application")
SetxlBook=xlApp.Workbooks.add
SetxlSheet=xlBook.Worksheets(1)
WithAdodc1.Recordset
.MoveLast
If.RecordCount<1Then
MsgBox("Error!")
ExitSub
EndIf
Irowcount=.RecordCount
Icolcount=.Fields.Count
ReDimFieldlen(Icolcount)
.MoveFirst
ForIrow=1ToIrowcount+1
ForIcol=1ToIcolcount
SelectCaseIrow
Case1
xlSheet.Cells(Irow,Icol).Value=.Fields(Icol-1).Name
Case2
IfIsNull(.Fields(Icol-1))=TrueThen
Fieldlen(Icol)=LenB(.Fields(Icol-1).Name)
Else
Fieldlen(Icol)=LenB(.Fields(Icol-1))
EndIf
xlSheet.Columns(Icol).ColumnWidth=Fieldlen(Icol)
xlSheet.Cells(Irow,Icol).Value=.Fields(Icol-1)
CaseElse
Fieldlen1=LenB(.Fields(Icol-1))
IfFieldlen(Icol)
1Then
IfNot.EOFThen.MoveNext
ProgressBar1.Value=ProgressBar1.Value+1
EndIf
Next
WithxlSheet
.Range(.Cells(1,1),.Cells(1,Icol-1)).Font.Name="黑体"
.Range(.Cells(1,1),.Cells(1,Icol-1)).Font.Bold=True
.Range(.Cells(1,1),.Cells(Irow,Icol-1)).Borders.LineStyle=xlContinuous
EndWith
xlApp.Visible=True
'xlBook.Save
'xlBook.Close
SetxlApp=Nothing
Adodc1.Recordset.ActiveConnection=Nothing
EndWith
Toolbar4.Buttons(1).Enabled=False
Case2
UnloadMe
EndSelect
4.4高校固定资产管理系统
4.4.1学生请假
学生请假与违规在一个高校固定资产管理系统中是最常见的问题了,所以在此软件中加上了这两项功能。用它们可以随时记录请假记录。
①学生请假记录图片显示
图4.9学生请假效果图
②界面制作与实现
此界面主要是对学生请假记录做一个添加。利用它可以把学生的基本的请假资料保存起来。其中的日期是系统当前的日期,它是不可以进行更改的,然后在其它文本框中输入其它详细资料即可以。这里的添加操作用的是Adodc控件,所有的文本框在初始的时候没有同Adodc绑定,而是在代码中与数据库中表的字段进行的绑定,然后进行添加操作。这样做在使用的时候有很大的方便之处。第一是窗体在初始化时不会显示任何记录,不用设置文本框为空等一系列的操作。第二是当进行记录输入时,发现问题不用输入时,不按添加按钮记录就不会进行添加。注意的是,在添加前要确定所有的文本框都要进行详细填写,否则会提示输入详细信息。添加主要代码如下:
IfText1.Text=""OrText2.Text=""OrText3.Text=""OrText4.Text=""OrText5.Text=""OrText6.Text=""OrText7.Text=""OrText8.Text=""OrText9.Text=""Then
MsgBox"请输入详细信息!",,"系统提示"
Else
WithAdodc1
.Recordset.AddNew
.Recordset.Fields(0).Value=Text1.Text
.Recordset.Fields(1).Value=Text2.Text
.Recordset.Fields(2).Value=Text3.Text
.Recordset.Fields(3).Value=Text4.Text
.Recordset.Fields(4).Value=Text5.Text
.Recordset.Fields(5).Value=Text6.Text
.Recordset.Fields(6).Value=Text7.Text
.Recordset.Fields(7).Value=Text8.Text
.Recordset.Fields
上一篇:餐饮酒店管理系统(论文和程序)
下一篇:试析影响公路路面平整度的因素及应采取的施工措施