Code that works on XP but not on Vista

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Hi.

I have this code in a switchboard form and it works perfectly in the windows
xp but not on Vista.

Why?

I'm using Office 2003

Thanks,
Marco
 
Marco said:
Hi.

I have this code in a switchboard form and it works perfectly in the
windows
xp but not on Vista.

Why?

I'm using Office 2003

Thanks,
Marco
Click to expand...

What code is that, then?
 
sorry.

Option Compare Database
Option Explicit

Const conNumButtons = 8
Const conFontWeightBold = 700
Const conFontWeightNormal = 400

Private Sub cmdExit_Click()
On Error GoTo Err_cmdExit_Click

Dim stDocName As String

stDocName = "mcr_exit"
DoCmd.RunMacro stDocName

Exit_cmdExit_Click:
Exit Sub

Err_cmdExit_Click:
MsgBox Err.Description
Resume Exit_cmdExit_Click
End Sub

Private Sub cmdExit_GotFocus()
Dim intOption As Integer

'If the Exit Button has received the focus, turn off the focus on all
the menu options
For intOption = 1 To conNumButtons
Me("Option" & intOption).Visible = False
Me("OptionLabel" & intOption).FontWeight = conFontWeightNormal
Next intOption

ExitLabel.FontUnderline = True
End Sub

Private Sub cmdExit_LostFocus()
ExitLabel.FontUnderline = False
End Sub

Private Sub cmdExit_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single)
ExitLabel.FontWeight = conFontWeightBold
End Sub

Private Sub cmdExit_MouseUp(Button As Integer, Shift As Integer, X As
Single, Y As Single)
ExitLabel.FontWeight = conFontWeightNormal
End Sub

Private Sub Form_Open(Cancel As Integer)

Me.Filter = "[ItemNumber] = 0 AND [Argument] = 'Default' "
Me.FilterOn = True


Dim stDocName As String
stDocName = "mcr_FechaSplash"
DoCmd.RunMacro stDocName



End Sub

Private Sub Form_Current()


Me.Caption = Nz(Me![ItemText], "")
FillOptions




End Sub

Private Sub FillOptions()


Dim dbs As Database
Dim rst As Recordset
Dim strSQL As String
Dim intOption As Integer


Me![Option1].Visible = True
Me![Command1].Enabled = True
Me![Command1].SetFocus
With Me![OptionLabel1]
.Visible = True
.FontWeight = conFontWeightBold
End With
For intOption = 2 To conNumButtons
Me("Option" & intOption).Visible = False
Me("OptionLabel" & intOption).Visible = False
Me("OptionLabel" & intOption).FontWeight = conFontWeightNormal
Me("Command" & intOption).Enabled = False
Next intOption


Set dbs = CurrentDb()
strSQL = "SELECT * FROM [Switchboard Items]"
strSQL = strSQL & " WHERE [ItemNumber] > 0 AND [SwitchboardID]=" &
Me![SwitchboardID]
strSQL = strSQL & " ORDER BY [ItemNumber];"
Set rst = dbs.OpenRecordset(strSQL)


If (rst.EOF) Then
Me![OptionLabel1].Caption = "There are no items for this switchboard
page"
Else
While (Not (rst.EOF))
Me("OptionLabel" & rst![ItemNumber]).Visible = True
Me("OptionLabel" & rst![ItemNumber]).Caption = rst![ItemText]
Me("Command" & rst![ItemNumber]).Enabled = True
rst.MoveNext
Wend
End If

' Close the recordset and the database.
rst.Close
dbs.Close

End Sub

Private Function HandleFocus(intBtn As Integer)
' This function is called when a menu option receives the focus.
' intBtn indicates which button was clicked.

Dim intOption As Integer

On Error GoTo HandleMouseOver_Err

For intOption = 1 To conNumButtons
'Show that this menu option has the focus...
If intOption = intBtn Then
Me("Option" & intOption).Visible = True
Me("OptionLabel" & intOption).FontWeight = conFontWeightBold
Me("command" & intBtn).SetFocus
'... and turn off the focus on the other options
Else
Me("Option" & intOption).Visible = False
Me("OptionLabel" & intOption).FontWeight = conFontWeightNormal
End If
Next intOption

HandleMouseOver_Exit:
Exit Function

HandleMouseOver_Err:
MsgBox "Não tem acesso a esta opção. Obrigado.", vbCritical
Resume HandleMouseOver_Exit

End Function

Private Function HandleButtonClick(intBtn As Integer)
' This function is called when a button is clicked.
' intBtn indicates which button was clicked.

' Constants for the commands that can be executed.
Const conCmdGotoSwitchboard = 1
Const conCmdOpenFormAdd = 2
Const conCmdOpenFormBrowse = 3
Const conCmdOpenReport = 4
Const conCmdCustomizeSwitchboard = 5
Const conCmdExitApplication = 6
Const conCmdRunMacro = 7
Const conCmdRunCode = 8

' An error that is special cased.
Const conErrDoCmdCancelled = 2501

Dim dbs As Database
Dim rst As Recordset

On Error GoTo HandleButtonClick_Err

' Find the item in the Switchboard Items table
' that corresponds to the button that was clicked.
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("Switchboard Items", dbOpenDynaset)
rst.FindFirst "[SwitchboardID]=" & Me![SwitchboardID] & " AND
[ItemNumber]=" & intBtn

' If no item matches, report the error and exit the function.
If (rst.NoMatch) Then
MsgBox "There was an error reading the Switchboard Items table."
rst.Close
dbs.Close
Exit Function
End If

Select Case rst![Command]

' Go to another switchboard.
Case conCmdGotoSwitchboard
Me.Filter = "[ItemNumber] = 0 AND [SwitchboardID]=" &
rst![Argument]

' Open a form in Add mode.
Case conCmdOpenFormAdd
DoCmd.OpenForm rst![Argument], , , , acAdd

' Open a form.
Case conCmdOpenFormBrowse
DoCmd.OpenForm rst![Argument]

' Open a report.
Case conCmdOpenReport
DoCmd.OpenReport rst![Argument], acPreview

' Customize the Switchboard.
Case conCmdCustomizeSwitchboard
' Handle the case where the Switchboard Manager
' is not installed (e.g. Minimal Install).
On Error Resume Next
Application.Run "ACWZMAIN.sbm_Entry"
If (Err <> 0) Then MsgBox "Não tem acesso a esta opção. Obrigado."
On Error GoTo 0
' Update the form.
Me.Filter = "[ItemNumber] = 0 AND [Argument] = 'Default' "
Me.Caption = Nz(Me![ItemText], "")
FillOptions

' Exit the application.
Case conCmdExitApplication
CloseCurrentDatabase

' Run a macro.
Case conCmdRunMacro
DoCmd.RunMacro rst![Argument]

' Run code.
Case conCmdRunCode
Application.Run rst![Argument]

' Any other command is unrecognized.
Case Else
MsgBox "Não tem acesso a esta opção. Obrigado."

End Select

' Close the recordset and the database.
rst.Close
dbs.Close

HandleButtonClick_Exit:
Exit Function

HandleButtonClick_Err:
' If the action was cancelled by the user for
' some reason, don't display an error message.
' Instead, resume on the next line.
If (Err = conErrDoCmdCancelled) Then
Resume Next
Else
MsgBox "Não tem acesso a esta opção. Obrigado.", vbCritical
Resume HandleButtonClick_Exit
End If

End Function
 
Marco said:
sorry.

Option Compare Database
Option Explicit

Const conNumButtons = 8
Const conFontWeightBold = 700
Const conFontWeightNormal = 400

Private Sub cmdExit_Click()
On Error GoTo Err_cmdExit_Click

Dim stDocName As String

stDocName = "mcr_exit"
DoCmd.RunMacro stDocName

Exit_cmdExit_Click:
Exit Sub

Err_cmdExit_Click:
MsgBox Err.Description
Resume Exit_cmdExit_Click
End Sub

Private Sub cmdExit_GotFocus()
Dim intOption As Integer

'If the Exit Button has received the focus, turn off the focus on all
the menu options
For intOption = 1 To conNumButtons
Me("Option" & intOption).Visible = False
Me("OptionLabel" & intOption).FontWeight = conFontWeightNormal
Next intOption

ExitLabel.FontUnderline = True
End Sub

Private Sub cmdExit_LostFocus()
ExitLabel.FontUnderline = False
End Sub

Private Sub cmdExit_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single)
ExitLabel.FontWeight = conFontWeightBold
End Sub

Private Sub cmdExit_MouseUp(Button As Integer, Shift As Integer, X As
Single, Y As Single)
ExitLabel.FontWeight = conFontWeightNormal
End Sub

Private Sub Form_Open(Cancel As Integer)

Me.Filter = "[ItemNumber] = 0 AND [Argument] = 'Default' "
Me.FilterOn = True


Dim stDocName As String
stDocName = "mcr_FechaSplash"
DoCmd.RunMacro stDocName



End Sub

Private Sub Form_Current()


Me.Caption = Nz(Me![ItemText], "")
FillOptions




End Sub

Private Sub FillOptions()


Dim dbs As Database
Dim rst As Recordset
Dim strSQL As String
Dim intOption As Integer


Me![Option1].Visible = True
Me![Command1].Enabled = True
Me![Command1].SetFocus
With Me![OptionLabel1]
.Visible = True
.FontWeight = conFontWeightBold
End With
For intOption = 2 To conNumButtons
Me("Option" & intOption).Visible = False
Me("OptionLabel" & intOption).Visible = False
Me("OptionLabel" & intOption).FontWeight = conFontWeightNormal
Me("Command" & intOption).Enabled = False
Next intOption


Set dbs = CurrentDb()
strSQL = "SELECT * FROM [Switchboard Items]"
strSQL = strSQL & " WHERE [ItemNumber] > 0 AND [SwitchboardID]=" &
Me![SwitchboardID]
strSQL = strSQL & " ORDER BY [ItemNumber];"
Set rst = dbs.OpenRecordset(strSQL)


If (rst.EOF) Then
Me![OptionLabel1].Caption = "There are no items for this
switchboard
page"
Else
While (Not (rst.EOF))
Me("OptionLabel" & rst![ItemNumber]).Visible = True
Me("OptionLabel" & rst![ItemNumber]).Caption = rst![ItemText]
Me("Command" & rst![ItemNumber]).Enabled = True
rst.MoveNext
Wend
End If

' Close the recordset and the database.
rst.Close
dbs.Close

End Sub

Private Function HandleFocus(intBtn As Integer)
' This function is called when a menu option receives the focus.
' intBtn indicates which button was clicked.

Dim intOption As Integer

On Error GoTo HandleMouseOver_Err

For intOption = 1 To conNumButtons
'Show that this menu option has the focus...
If intOption = intBtn Then
Me("Option" & intOption).Visible = True
Me("OptionLabel" & intOption).FontWeight = conFontWeightBold
Me("command" & intBtn).SetFocus
'... and turn off the focus on the other options
Else
Me("Option" & intOption).Visible = False
Me("OptionLabel" & intOption).FontWeight = conFontWeightNormal
End If
Next intOption

HandleMouseOver_Exit:
Exit Function

HandleMouseOver_Err:
MsgBox "Não tem acesso a esta opção. Obrigado.", vbCritical
Resume HandleMouseOver_Exit

End Function

Private Function HandleButtonClick(intBtn As Integer)
' This function is called when a button is clicked.
' intBtn indicates which button was clicked.

' Constants for the commands that can be executed.
Const conCmdGotoSwitchboard = 1
Const conCmdOpenFormAdd = 2
Const conCmdOpenFormBrowse = 3
Const conCmdOpenReport = 4
Const conCmdCustomizeSwitchboard = 5
Const conCmdExitApplication = 6
Const conCmdRunMacro = 7
Const conCmdRunCode = 8

' An error that is special cased.
Const conErrDoCmdCancelled = 2501

Dim dbs As Database
Dim rst As Recordset

On Error GoTo HandleButtonClick_Err

' Find the item in the Switchboard Items table
' that corresponds to the button that was clicked.
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("Switchboard Items", dbOpenDynaset)
rst.FindFirst "[SwitchboardID]=" & Me![SwitchboardID] & " AND
[ItemNumber]=" & intBtn

' If no item matches, report the error and exit the function.
If (rst.NoMatch) Then
MsgBox "There was an error reading the Switchboard Items table."
rst.Close
dbs.Close
Exit Function
End If

Select Case rst![Command]

' Go to another switchboard.
Case conCmdGotoSwitchboard
Me.Filter = "[ItemNumber] = 0 AND [SwitchboardID]=" &
rst![Argument]

' Open a form in Add mode.
Case conCmdOpenFormAdd
DoCmd.OpenForm rst![Argument], , , , acAdd

' Open a form.
Case conCmdOpenFormBrowse
DoCmd.OpenForm rst![Argument]

' Open a report.
Case conCmdOpenReport
DoCmd.OpenReport rst![Argument], acPreview

' Customize the Switchboard.
Case conCmdCustomizeSwitchboard
' Handle the case where the Switchboard Manager
' is not installed (e.g. Minimal Install).
On Error Resume Next
Application.Run "ACWZMAIN.sbm_Entry"
If (Err <> 0) Then MsgBox "Não tem acesso a esta opção.
Obrigado."
On Error GoTo 0
' Update the form.
Me.Filter = "[ItemNumber] = 0 AND [Argument] = 'Default' "
Me.Caption = Nz(Me![ItemText], "")
FillOptions

' Exit the application.
Case conCmdExitApplication
CloseCurrentDatabase

' Run a macro.
Case conCmdRunMacro
DoCmd.RunMacro rst![Argument]

' Run code.
Case conCmdRunCode
Application.Run rst![Argument]

' Any other command is unrecognized.
Case Else
MsgBox "Não tem acesso a esta opção. Obrigado."

End Select

' Close the recordset and the database.
rst.Close
dbs.Close

HandleButtonClick_Exit:
Exit Function

HandleButtonClick_Err:
' If the action was cancelled by the user for
' some reason, don't display an error message.
' Instead, resume on the next line.
If (Err = conErrDoCmdCancelled) Then
Resume Next
Else
MsgBox "Não tem acesso a esta opção. Obrigado.", vbCritical
Resume HandleButtonClick_Exit
End If

End Function
Click to expand...

Wow. That's an awful lot of code to wade through. What isn't working? Do you
get an error? If so, what's the error and on which code line does it break?
 
It's on load event. and on timer

Stuart McCall said:
Marco said:
sorry.

Option Compare Database
Option Explicit

Const conNumButtons = 8
Const conFontWeightBold = 700
Const conFontWeightNormal = 400

Private Sub cmdExit_Click()
On Error GoTo Err_cmdExit_Click

Dim stDocName As String

stDocName = "mcr_exit"
DoCmd.RunMacro stDocName

Exit_cmdExit_Click:
Exit Sub

Err_cmdExit_Click:
MsgBox Err.Description
Resume Exit_cmdExit_Click
End Sub

Private Sub cmdExit_GotFocus()
Dim intOption As Integer

'If the Exit Button has received the focus, turn off the focus on all
the menu options
For intOption = 1 To conNumButtons
Me("Option" & intOption).Visible = False
Me("OptionLabel" & intOption).FontWeight = conFontWeightNormal
Next intOption

ExitLabel.FontUnderline = True
End Sub

Private Sub cmdExit_LostFocus()
ExitLabel.FontUnderline = False
End Sub

Private Sub cmdExit_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single)
ExitLabel.FontWeight = conFontWeightBold
End Sub

Private Sub cmdExit_MouseUp(Button As Integer, Shift As Integer, X As
Single, Y As Single)
ExitLabel.FontWeight = conFontWeightNormal
End Sub

Private Sub Form_Open(Cancel As Integer)

Me.Filter = "[ItemNumber] = 0 AND [Argument] = 'Default' "
Me.FilterOn = True


Dim stDocName As String
stDocName = "mcr_FechaSplash"
DoCmd.RunMacro stDocName



End Sub

Private Sub Form_Current()


Me.Caption = Nz(Me![ItemText], "")
FillOptions




End Sub

Private Sub FillOptions()


Dim dbs As Database
Dim rst As Recordset
Dim strSQL As String
Dim intOption As Integer


Me![Option1].Visible = True
Me![Command1].Enabled = True
Me![Command1].SetFocus
With Me![OptionLabel1]
.Visible = True
.FontWeight = conFontWeightBold
End With
For intOption = 2 To conNumButtons
Me("Option" & intOption).Visible = False
Me("OptionLabel" & intOption).Visible = False
Me("OptionLabel" & intOption).FontWeight = conFontWeightNormal
Me("Command" & intOption).Enabled = False
Next intOption


Set dbs = CurrentDb()
strSQL = "SELECT * FROM [Switchboard Items]"
strSQL = strSQL & " WHERE [ItemNumber] > 0 AND [SwitchboardID]=" &
Me![SwitchboardID]
strSQL = strSQL & " ORDER BY [ItemNumber];"
Set rst = dbs.OpenRecordset(strSQL)


If (rst.EOF) Then
Me![OptionLabel1].Caption = "There are no items for this
switchboard
page"
Else
While (Not (rst.EOF))
Me("OptionLabel" & rst![ItemNumber]).Visible = True
Me("OptionLabel" & rst![ItemNumber]).Caption = rst![ItemText]
Me("Command" & rst![ItemNumber]).Enabled = True
rst.MoveNext
Wend
End If

' Close the recordset and the database.
rst.Close
dbs.Close

End Sub

Private Function HandleFocus(intBtn As Integer)
' This function is called when a menu option receives the focus.
' intBtn indicates which button was clicked.

Dim intOption As Integer

On Error GoTo HandleMouseOver_Err

For intOption = 1 To conNumButtons
'Show that this menu option has the focus...
If intOption = intBtn Then
Me("Option" & intOption).Visible = True
Me("OptionLabel" & intOption).FontWeight = conFontWeightBold
Me("command" & intBtn).SetFocus
'... and turn off the focus on the other options
Else
Me("Option" & intOption).Visible = False
Me("OptionLabel" & intOption).FontWeight = conFontWeightNormal
End If
Next intOption

HandleMouseOver_Exit:
Exit Function

HandleMouseOver_Err:
MsgBox "Não tem acesso a esta opção. Obrigado.", vbCritical
Resume HandleMouseOver_Exit

End Function

Private Function HandleButtonClick(intBtn As Integer)
' This function is called when a button is clicked.
' intBtn indicates which button was clicked.

' Constants for the commands that can be executed.
Const conCmdGotoSwitchboard = 1
Const conCmdOpenFormAdd = 2
Const conCmdOpenFormBrowse = 3
Const conCmdOpenReport = 4
Const conCmdCustomizeSwitchboard = 5
Const conCmdExitApplication = 6
Const conCmdRunMacro = 7
Const conCmdRunCode = 8

' An error that is special cased.
Const conErrDoCmdCancelled = 2501

Dim dbs As Database
Dim rst As Recordset

On Error GoTo HandleButtonClick_Err

' Find the item in the Switchboard Items table
' that corresponds to the button that was clicked.
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("Switchboard Items", dbOpenDynaset)
rst.FindFirst "[SwitchboardID]=" & Me![SwitchboardID] & " AND
[ItemNumber]=" & intBtn

' If no item matches, report the error and exit the function.
If (rst.NoMatch) Then
MsgBox "There was an error reading the Switchboard Items table."
rst.Close
dbs.Close
Exit Function
End If

Select Case rst![Command]

' Go to another switchboard.
Case conCmdGotoSwitchboard
Me.Filter = "[ItemNumber] = 0 AND [SwitchboardID]=" &
rst![Argument]

' Open a form in Add mode.
Case conCmdOpenFormAdd
DoCmd.OpenForm rst![Argument], , , , acAdd

' Open a form.
Case conCmdOpenFormBrowse
DoCmd.OpenForm rst![Argument]

' Open a report.
Case conCmdOpenReport
DoCmd.OpenReport rst![Argument], acPreview

' Customize the Switchboard.
Case conCmdCustomizeSwitchboard
' Handle the case where the Switchboard Manager
' is not installed (e.g. Minimal Install).
On Error Resume Next
Application.Run "ACWZMAIN.sbm_Entry"
If (Err <> 0) Then MsgBox "Não tem acesso a esta opção.
Obrigado."
On Error GoTo 0
' Update the form.
Me.Filter = "[ItemNumber] = 0 AND [Argument] = 'Default' "
Me.Caption = Nz(Me![ItemText], "")
FillOptions

' Exit the application.
Case conCmdExitApplication
CloseCurrentDatabase

' Run a macro.
Case conCmdRunMacro
DoCmd.RunMacro rst![Argument]

' Run code.
Case conCmdRunCode
Application.Run rst![Argument]

' Any other command is unrecognized.
Case Else
MsgBox "Não tem acesso a esta opção. Obrigado."

End Select

' Close the recordset and the database.
rst.Close
dbs.Close

HandleButtonClick_Exit:
Exit Function

HandleButtonClick_Err:
' If the action was cancelled by the user for
' some reason, don't display an error message.
' Instead, resume on the next line.
If (Err = conErrDoCmdCancelled) Then
Resume Next
Else
MsgBox "Não tem acesso a esta opção. Obrigado.", vbCritical
Resume HandleButtonClick_Exit
End If

End Function
Click to expand...

Wow. That's an awful lot of code to wade through. What isn't working? Do you
get an error? If so, what's the error and on which code line does it break?
Click to expand...
 
Marco said:
It's on load event. and on timer
Click to expand...

<BIG SNIP>

Well I've looked over your code very carefully but I can find no OnLoad
event or OnTimer event.

Which means I'll have to guess. I'd put my money on the timer stuff. Don't
ask why - I said this was a guess.

What happens that you don't expect to happen? Or what doesn't happen that
you expect to happen?

We (the group) need clarification as to exactly what your problem is before
anyone can offer a fix.
 
Back
Top