Label Caption Problem
 

Hi,

I'm having a problem with 'updating' a textbox message.

When i go through the code below in DEBUG mode, everything works as
should be.
The label 'lblMessage' shows the text as wanted, but when i swith to
RUN TIME mode, this label does'n show the text. The meaning of this
text is to inform the user that a folder is being removed (deleted)
and then replaced with an updated folder. Personally, i think that the
problem lies in the use of the File Scripting code. Is this a known
problem, and if so, is there a work around to prevent this problem?
I'm working on Win98 SE, Excel 2000 SR1

Thanks in advance,
Ludo Soete


Private Sub lbDrives_Click()
Dim fsys As Object
Dim Drives As Object
Dim Drive As Object
Dim Folder As Object
Dim Files As Object
Dim file As Object
Dim Exist As Object

Dim selection As Integer
Dim strDestinationDrive As String
Dim FreeSpace As String
Dim sourcefile As String
Dim destinationfile As String
Dim DestinationPath As String
Dim sourcefolder As String
Dim destinationfolder As String
Dim SelectedDrive As String
Dim Tekst As String

Set fsys = CreateObject("scripting.filesystemobject")
Set Drives = fsys.Drives
Set Folder = fsys.GetFolder(strThisPath)
Set Files = Folder.Files

strDestinationDrive = Me.lbDrives.Text
selection = lbDrives.ListIndex
Me.lbDrives.TextColumn = 1
Me.cmdCancel.Enabled = False
SelectedDrive = lbDrives.Text
DestinationPath = Right$(strThisPath, Len(strThisPath) - 1)
'
If dummy = 1 Then 'backup
' check if enough free diskspace
Me.lbDrives.TextColumn = 3
FreeSpace = lbDrives.Text
If FreeSpace < (NeededDiscSpace / 1024) Then
MsgBox "Not enough disc space !" & Chr(13) & "Select other
drive!", vbOKOnly + vbCritical
Exit Sub
End If
'
Me.Label5.Caption = "" 'This works fine
Me.Label6.Caption = "" 'This works fine
Application.Wait (Now + TimeValue("0:00:01"))
'check if folder exist
destinationfolder = strDestinationDrive & ":\BeLUG Admin"
sourcefolder = strThisPath
On Error Resume Next
Set Exist = fsys.GetFolder(destinationfolder)
If Trim(Exist) = "" Then
Select Case Language
Case 31 'Dutch
With Me.lblMessage
.ForeColor = vbGreen
.Caption = Sheets("blad2").Range("a69").Value &
destinationfolder ' The text does'n appear, neather becomes the
textbox visible
.Visible = True
End With
Case 33 'French
With Me.lblMessage
.ForeColor = vbGreen
.Caption = Sheets("blad2").Range("b69").Value &
destinationfolder 'The text does'n appear, neather becomes the
textbox visible
.Visible = True
End With
Case Else 'USA
With Me.lblMessage
.ForeColor = vbGreen
.Caption = Sheets("blad2").Range("c69").Value &
destinationfolder 'The text does'n appear, neather becomes the
textbox visible
.Visible = True
End With
End Select
fsys.CopyFolder sourcefolder, destinationfolder, True
Me.lblMessage.Visible = False
Else
Select Case Language
Case 31 'Dutch
Tekst = Sheets("blad2").Range("a68").Value
Case 33
Tekst = Sheets("blad2").Range("b68").Value
Case Else
Tekst = Sheets("blad2").Range("c68").Value
End Select
dummy = MsgBox(Tekst, vbCritical + vbOKCancel)
Select Case dummy
Case vbOK 'Backup Folder
Select Case Language
Case 31 'Dutch
Tekst =
Sheets("blad2").Range("a73").Value
Case 33 'French
Tekst =
Sheets("blad2").Range("b73").Value
Case Else 'USA
Tekst =
Sheets("blad2").Range("c73").Value
End Select
With Me.lblMessage
.ForeColor = vbRed
.Caption = Tekst
.Visible = True 'The text does'n appear,
neather becomes the textbox visible
End With
fsys.DeleteFolder destinationfolder, True
Select Case Language
Case 31 'Dutch
Tekst =
Sheets("blad2").Range("a69").Value
Case 33 'French
Tekst =
Sheets("blad2").Range("b69").Value
Case Else 'USA
Tekst =
Sheets("blad2").Range("c69").Value
End Select
With Me
.lblMessage.ForeColor = vbBlue
.lblMessage.Caption = Tekst &
destinationfolder 'The text does'n appear, neather becomes the
textbox visible
End With
fsys.CopyFolder sourcefolder,
destinationfolder, True
Me.lblMessage.Visible = False
Case vbCancel 'No Backup
End Select
End If
End If
Unload Me
End Sub

Label Caption Problem
 

Ludo,

I haven't tried running this, but it may be as simple as placing a DoEvents
statement after any code updating the caption.

Robin Hammond
www.enhanceddatasystems.com


"Ludo Soete" wrote in message
om...
Hi,

I'm having a problem with 'updating' a textbox message.

When i go through the code below in DEBUG mode, everything works as
should be.
The label 'lblMessage' shows the text as wanted, but when i swith to
RUN TIME mode, this label does'n show the text. The meaning of this
text is to inform the user that a folder is being removed (deleted)
and then replaced with an updated folder. Personally, i think that the
problem lies in the use of the File Scripting code. Is this a known
problem, and if so, is there a work around to prevent this problem?
I'm working on Win98 SE, Excel 2000 SR1

Thanks in advance,
Ludo Soete


Private Sub lbDrives_Click()
Dim fsys As Object
Dim Drives As Object
Dim Drive As Object
Dim Folder As Object
Dim Files As Object
Dim file As Object
Dim Exist As Object

Dim selection As Integer
Dim strDestinationDrive As String
Dim FreeSpace As String
Dim sourcefile As String
Dim destinationfile As String
Dim DestinationPath As String
Dim sourcefolder As String
Dim destinationfolder As String
Dim SelectedDrive As String
Dim Tekst As String

Set fsys = CreateObject("scripting.filesystemobject")
Set Drives = fsys.Drives
Set Folder = fsys.GetFolder(strThisPath)
Set Files = Folder.Files

strDestinationDrive = Me.lbDrives.Text
selection = lbDrives.ListIndex
Me.lbDrives.TextColumn = 1
Me.cmdCancel.Enabled = False
SelectedDrive = lbDrives.Text
DestinationPath = Right$(strThisPath, Len(strThisPath) - 1)
'
If dummy = 1 Then 'backup
' check if enough free diskspace
Me.lbDrives.TextColumn = 3
FreeSpace = lbDrives.Text
If FreeSpace < (NeededDiscSpace / 1024) Then
MsgBox "Not enough disc space !" & Chr(13) & "Select other
drive!", vbOKOnly + vbCritical
Exit Sub
End If
'
Me.Label5.Caption = "" 'This works fine
Me.Label6.Caption = "" 'This works fine
Application.Wait (Now + TimeValue("0:00:01"))
'check if folder exist
destinationfolder = strDestinationDrive & ":\BeLUG Admin"
sourcefolder = strThisPath
On Error Resume Next
Set Exist = fsys.GetFolder(destinationfolder)
If Trim(Exist) = "" Then
Select Case Language
Case 31 'Dutch
With Me.lblMessage
.ForeColor = vbGreen
.Caption = Sheets("blad2").Range("a69").Value &
destinationfolder ' The text does'n appear, neather becomes the
textbox visible
.Visible = True
End With
Case 33 'French
With Me.lblMessage
.ForeColor = vbGreen
.Caption = Sheets("blad2").Range("b69").Value &
destinationfolder 'The text does'n appear, neather becomes the
textbox visible
.Visible = True
End With
Case Else 'USA
With Me.lblMessage
.ForeColor = vbGreen
.Caption = Sheets("blad2").Range("c69").Value &
destinationfolder 'The text does'n appear, neather becomes the
textbox visible
.Visible = True
End With
End Select
fsys.CopyFolder sourcefolder, destinationfolder, True
Me.lblMessage.Visible = False
Else
Select Case Language
Case 31 'Dutch
Tekst = Sheets("blad2").Range("a68").Value
Case 33
Tekst = Sheets("blad2").Range("b68").Value
Case Else
Tekst = Sheets("blad2").Range("c68").Value
End Select
dummy = MsgBox(Tekst, vbCritical + vbOKCancel)
Select Case dummy
Case vbOK 'Backup Folder
Select Case Language
Case 31 'Dutch
Tekst =
Sheets("blad2").Range("a73").Value
Case 33 'French
Tekst =
Sheets("blad2").Range("b73").Value
Case Else 'USA
Tekst =
Sheets("blad2").Range("c73").Value
End Select
With Me.lblMessage
.ForeColor = vbRed
.Caption = Tekst
.Visible = True 'The text does'n appear,
neather becomes the textbox visible
End With
fsys.DeleteFolder destinationfolder, True
Select Case Language
Case 31 'Dutch
Tekst =
Sheets("blad2").Range("a69").Value
Case 33 'French
Tekst =
Sheets("blad2").Range("b69").Value
Case Else 'USA
Tekst =
Sheets("blad2").Range("c69").Value
End Select
With Me
.lblMessage.ForeColor = vbBlue
.lblMessage.Caption = Tekst &
destinationfolder 'The text does'n appear, neather becomes the
textbox visible
End With
fsys.CopyFolder sourcefolder,
destinationfolder, True
Me.lblMessage.Visible = False
Case vbCancel 'No Backup
End Select
End If
End If
Unload Me
End Sub