sorry ,VB question

Results 1 to 2 of 2

Thread: sorry ,VB question

  1. #1
    Join Date
    Dec 1969

    Default sorry ,VB question

    i know this is a asp site,but if there are any VB GURUS out there,please help me.<BR>this code exports data alright.what i am stuck in is the displaying statusbar. <BR><BR>i am using "SysCmd" to display the progress bar in the statusbar.i have a form,2 text boxex,2 buttons,and a statusbar.i want to display the progress bar along with text like "creating table".if you copy and paste in a access macro,it works fine,i want it in vb. <BR>______________________________________________ __________________________________ <BR>the points are here <BR> <BR>______________________________________________ __________________________________ <BR>Const LogFile = "E:ackup.log" <BR>Public Function BackupDatabase(SourceDBName As String, BackupDBName As String) As Boolean <BR> <BR> Dim db As Database <BR> Dim BackupDB As Database <BR> Dim tdf As TableDef <BR> Dim newTdf As TableDef <BR> Dim fld As Field <BR> Dim newfld As Field <BR> Dim SourceRst As Recordset <BR> Dim BackupRst As Recordset <BR> Dim BackupNo As Integer <BR> Dim rst As Recordset <BR> Dim f As Integer <BR> Dim Msg As Variant <BR> Dim found As Boolean <BR> <BR> f = FreeFile() <BR> Open LogFile For Output As f <BR> <BR> On Error GoTo Backup_Err <BR> <BR> &#039 open source database <BR> Set db = OpenDatabase(SourceDBName) <BR> <BR> &#039 create backup database if not exists <BR> If Dir(BackupDBName) = "" Then <BR> Msg = SysCmd(acSysCmdSetStatus, "Creating backup database " & BackupDBName) <BR> Print #f, "Creating backup database " & BackupDBName <BR> Set BackupDB = DBEngine.CreateDatabase(BackupDBName, dbLangGeneral) <BR> Else <BR> Set BackupDB = OpenDatabase(BackupDBName) <BR> End If <BR> <BR> &#039 loop all tables <BR> For Each tdf In db.TableDefs <BR> <BR> &#039 do not copy system or temp tables <BR> If Left(tdf.Name, 4) &#060;&#062; "MSys" And Left(tdf.Name, 1) &#060;&#062; "~" Then <BR> <BR> &#039 check if table already exists? <BR> found = False <BR> For Each newTdf In BackupDB.TableDefs <BR> If newTdf.Name = tdf.Name Then found = True <BR> Next <BR> <BR> &#039 if not found, create tabledef & fields <BR> If Not found Then <BR> <BR> &#039 create new tabledef <BR> Msg = SysCmd(acSysCmdSetStatus, "Creating backup table " & tdf.Name) <BR> Print #f, "Creating table " & tdf.Name <BR> Set newTdf = BackupDB.CreateTableDef(tdf.Name) <BR> <BR> &#039 create fields <BR> For Each fld In tdf.Fields <BR> Print #f, "Adding field " & fld.Name <BR> Set newfld = newTdf.CreateField(fld.Name, fld.Type, fld.Size) <BR> newTdf.Fields.Append newfld <BR> Next fld <BR> <BR> &#039 add new tabledef to backup databse <BR> BackupDB.TableDefs.Append newTdf <BR> <BR> &#039 Very important! Modify text and memo type fields that Allow Zero Length property <BR> &#039 is always True! <BR> For Each newfld In BackupDB.TableDefs(tdf.Name).Fields <BR> If newfld.Type = dbText Or newfld.Type = dbMemo Then <BR> newfld.Properties("AllowZeroLength") = True <BR> End If <BR> Next <BR> <BR> End If <BR> <BR> &#039 copy data from source to backup db <BR> Set SourceRst = db.OpenRecordset(tdf.Name) <BR> Set BackupRst = BackupDB.OpenRecordset(tdf.Name) <BR> Print #f, "Copying table " & tdf.Name & " data" <BR> <BR> &#039 check if there&#039s any data to copy <BR> If Not (SourceRst.BOF And SourceRst.EOF) Then <BR> SourceRst.MoveFirst <BR> <BR> Msg = SysCmd(acSysCmdInitMeter, "Making backup of table " _ <BR> & tdf.Name, 100) <BR> &#039 ignore all errors during the copy process <BR> On Error Resume Next <BR> <BR> &#039 copy all data from source table to backup database table <BR> While Not SourceRst.EOF <BR> Msg = SysCmd(acSysCmdUpdateMeter, SourceRst.PercentPosition) <BR> BackupRst.AddNew <BR> DoEvents <BR> For Each fld In SourceRst.Fields <BR> BackupRst.Fields(fld.Name) = SourceRst.Fields(fld.Name) <BR> If Err.Number &#060;&#062; 0 Then <BR> Print #f, "Error copying field &#039" & fld.Name & "&#039 value: & " _ <BR> ; CStr(Nz(SourceRst.Fields(fld.Name), "")) <BR> Err.Clear <BR> End If <BR> Next <BR> BackupRst.Update <BR> SourceRst.MoveNext <BR> Wend <BR> Msg = SysCmd(acSysCmdClearStatus) <BR> Print #f, "Copied " & CStr(SourceRst.RecordCount) & " records" <BR> <BR> &#039 catch errors again... <BR> On Error GoTo Backup_Err <BR> End If <BR> End If <BR> Next tdf <BR> Msg = SysCmd(acSysCmdSetStatus, "Backup operation successfully completed.") <BR> Print #f, "Backup operation successfully finished" <BR> BackupDatabase = True <BR> MsgBox "Operation Data Transfer Successful,please copy destination database and rename it as grs.mdb and put it in the users folder" <BR> Command1.Enabled = True <BR>Backup_Exit: <BR> <BR> Msg = SysCmd(acSysCmdClearStatus) <BR> Close <BR> Set BackupDB = Nothing <BR> Set db = Nothing <BR> Set tdf = Nothing <BR> Set newTdf = Nothing <BR> Set fld = Nothing <BR> Set newfld = Nothing <BR> Set SourceRst = Nothing <BR> Set BackupRst = Nothing <BR> Set rst = Nothing <BR> Exit Function <BR> <BR>Backup_Err: <BR> <BR> BackupDatabase = False <BR> MsgBox "Backup operation failed: " & Err.Description, vbCritical <BR> Resume Backup_Exit <BR> <BR>End Function <BR>Private Sub Command1_Click() <BR>Command1.Enabled = False <BR>Call BackupDatabase(Text1.Text, Text2.Text) <BR>End Sub <BR><BR>Private Sub Command2_Click() <BR>Unload Me <BR>End Sub<BR>

  2. #2
    Join Date
    Dec 1969

    Default RE: sorry ,VB question

    You need to add one or more panels to your statusbar control and when your msg variable changes, ...<BR><BR>panel1.text = msg

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts