VB6 Stop that command click

[Dave]

I've been trying to ensure that a VB6 form's command button is only clicked once. Clicking twice gets the "component request pending" error message (action can't be completed because other application is busy etc... switch to/retry). I've tried enabling (T/F) the button (same result), and the code below, which does change the command button to red but still generates the error if the button is clicked again while the form is visible. Hiding the form before calling the InsertFormula routine doesn't work ie. quickly double clicking the button causes the same error. The insert formula routine open's an XL file, inserts formulas then saves the file and quits the application. Any suggestions will be appreciated. Dave

Private Sub command2_Click()
If Form1.Command2.BackColor = RGB(255, 0, 0) Then
Exit Sub
End If
Form1.Command2.BackColor = RGB(255, 0, 0) 'red
Call InsertFormula
Form1.Hide

[lucas]

You can disable the button until controls are filled in excel anyway...not sure about vb:
Private Sub Userform_Initialize()
ComboBox1.AddItem ("12")
ComboBox1.AddItem ("Joe")
ComboBox1.AddItem ("Joe")
ComboBox2.AddItem ("is")
ComboBox3.AddItem ("cool.")

CommandButton1.Enabled = False
End Sub

then enable it if conditions are correct:
Private Sub ComboBox1_Change()
If ComboBox1.Value <> "" And ComboBox2.Value <> "" And ComboBox3.Value <> "" Then
CommandButton1.Enabled = True
Else
CommandButton1.Enabled = False
End If
End Sub

Private Sub ComboBox2_Change()
If ComboBox1.Value <> "" And ComboBox2.Value <> "" And ComboBox3.Value <> "" Then
CommandButton1.Enabled = True
Else
CommandButton1.Enabled = False
End If
End Sub

Private Sub ComboBox3_Change()
If ComboBox1.Value <> "" And ComboBox2.Value <> "" And ComboBox3.Value <> "" Then
CommandButton1.Enabled = True
Else
CommandButton1.Enabled = False
End If
End Sub

[Dave]

Thanks Lucas but changing the enabling does not work. Neither does using cancel. Hmm? :dunno Dave

[Bob Phillips]

Dave

Can you post the VB6 project to save us re-inventing it?

And the Excel book if there is one.

[XLGibbs]

WHat is Insertformula doing? Is the problem within that?

[Dave]

Thank you both for your interest and anticipated assistance. I've made some test files which represent the problem. The XLS file goes directly to the "C" drive. I'll post again with the VB6 file. You will probably need to use the task manager to stop the XL application if you click the VB6 form button too fast. Dave
The insertformula routine is as follows...

Sub InsertFormula()
Dim objExcel As Object, objWorkBook As Object, objWorksheet As Object

On Error GoTo ErFix
Set objExcel = CreateObject("EXCEL.APPLICATION")
Set objWorkBook = objExcel.Workbooks.Open("C:\clicktest.xls")
Set objWorksheet = objWorkBook.Worksheets("Sheet1")
objWorksheet.Cells(1, 1).Formula = "=B1+C1"
objWorkBook.Close SaveChanges:=True
objExcel.Quit
Set objWorksheet = Nothing
Set objWorkBook = Nothing
Set objExcel = Nothing
Exit Sub
ErFix:
On Error GoTo 0
MsgBox "XLap error(4)"
objExcel.DisplayAlerts = False
objExcel.Quit
Set objWorksheet = Nothing
Set objWorkBook = Nothing
Set objExcel = Nothing
End Sub

[Dave]

Here's the VB6 test project. Dave
ps. just noticed that if you click the VB6 form's button really fast, it actually clicks itself and repeats the button's routine after the XL form unload.

[XLGibbs]

VB project is missing the other components, like the form and the code.

Have you tried debugging without the error handler to see what error it throws? line by line using F8?

[XLGibbs]

Function IsWbOpen(wbName As String) As Boolean
Dim i As Long
For i = Workbooks.Count To 1 Step -1
If Workbooks(i).Name = wbName Then Exit For
Next
If i <> 0 Then IsWbOpen = True
End Function
May want to have that quick IsWbOpen check (courtesy of firefytr's KB entry) before the process runs. Seems to be if the workbook is open, and or currently saving when the button is clicked that it would cause some issues.

I would check if it is already open and if so, exist sub.

[Dave]

That didn't seem to work. Apologies re. VB6 file. I'll try again. Dave
edit: that didn't work either. It says it's the vbp file? I'll try it again

[Dave]

Made it .exe. Dave
edit: still doesn't give code. Here's the VB6 form code. The project just has a form with a command button1 on it. Dave

Private Sub command1_Click()
Dim objExcel As Object, objWorkBook As Object
Dim Clickcnt As Integer, objWorksheet As Object
Clickcnt = Clickcnt + 1
If Form1.Command1.BackColor = RGB(255, 0, 0) Then
Exit Sub
End If 'red
Form1.Command1.BackColor = RGB(255, 0, 0) 'red
Call InsertFormula
Form1.Hide

On Error GoTo ErFix
Set objExcel = CreateObject("EXCEL.APPLICATION")
Set objWorkBook = objExcel.Workbooks.Open("C:\clicktest.xls")
objExcel.Run "showuserform1"
objExcel.DisplayAlerts = False
objExcel.Quit
Set objWorkBook = Nothing
Set objExcel = Nothing
Call RemoveFormula
Form1.Command1.BackColor = RGB(0, 128, 64) 'green
Form1.Show
Exit Sub
ErFix:
On Error GoTo 0
MsgBox "XLap error(3)"
MsgBox "You clicked: " & Clickcnt & " times!"
objExcel.DisplayAlerts = False
objExcel.Quit
Set objWorkBook = Nothing
Set objExcel = Nothing
Call RemoveFormula
Form1.Command1.BackColor = RGB(0, 128, 64) 'green
Form1.Show
End Sub

Sub InsertFormula()
Dim objExcel As Object, objWorkBook As Object
Dim objWorksheet As Object

On Error GoTo ErFix
Set objExcel = CreateObject("EXCEL.APPLICATION")
Set objWorkBook = objExcel.Workbooks.Open("C:\clicktest.xls")
Set objWorksheet = objWorkBook.Worksheets("Sheet1")
objWorksheet.Cells(1, 1).Formula = "=B1+C1"
objWorkBook.Close SaveChanges:=True
objExcel.Quit
Set objWorksheet = Nothing
Set objWorkBook = Nothing
Set objExcel = Nothing
Exit Sub
ErFix:
On Error GoTo 0
MsgBox "XLap error(4)"
objExcel.DisplayAlerts = False
objExcel.Quit
Set objWorksheet = Nothing
Set objWorkBook = Nothing
Set objExcel = Nothing
End Sub

Sub RemoveFormula()
Dim objExcel As Object, objWorkBook As Object
Dim objWorksheet As Object

On Error GoTo ErFix
Set objExcel = CreateObject("EXCEL.APPLICATION")
Set objWorkBook = objExcel.Workbooks.Open("C:\clicktest.xls")
Set objWorksheet = objWorkBook.Worksheets("Sheet1")
objWorksheet.Cells(1, 1).Formula = ""
objWorkBook.Close SaveChanges:=True
objExcel.Quit
Set objWorksheet = Nothing
Set objWorkBook = Nothing
Set objExcel = Nothing
Exit Sub
ErFix:
On Error GoTo 0
MsgBox "XLap error(5)"
objExcel.DisplayAlerts = False
objExcel.Quit
Set objWorksheet = Nothing
Set objWorkBook = Nothing
Set objExcel = Nothing
End Sub

[Tommy]

Hi Dave, :hi:

Why not as lucas has pointed out use the enabled feature?

Private Sub command1_Click()
Dim objExcel As Object, objWorkBook As Object
Dim Clickcnt As Integer, objWorksheet As Object
Command1.Enabled = False '-Added
Clickcnt = Clickcnt + 1
If Form1.Command1.BackColor = RGB(255, 0, 0) Then
Exit Sub
End If 'red
Form1.Command1.BackColor = RGB(255, 0, 0) 'red
Call InsertFormula
Form1.Hide

On Error GoTo ErFix
Set objExcel = CreateObject("EXCEL.APPLICATION")
Set objWorkBook = objExcel.Workbooks.Open("C:\clicktest.xls")
objExcel.Run "showuserform1"
objExcel.DisplayAlerts = False
objExcel.Quit
Set objWorkBook = Nothing
Set objExcel = Nothing
Call RemoveFormula
Form1.Command1.BackColor = RGB(0, 128, 64) 'green
Command1.Enabled = True '-Added
Form1.Show
Exit Sub
ErFix:
On Error GoTo 0
MsgBox "XLap error(3)"
MsgBox "You clicked: " & Clickcnt & " times!"
objExcel.DisplayAlerts = False
objExcel.Quit
Set objWorkBook = Nothing
Set objExcel = Nothing
Call RemoveFormula
Form1.Command1.BackColor = RGB(0, 128, 64) 'green
Command1.Enabled = True '-Added
Form1.Show
End Sub

Sub InsertFormula()
Dim objExcel As Object, objWorkBook As Object
Dim objWorksheet As Object

On Error GoTo ErFix
Set objExcel = CreateObject("EXCEL.APPLICATION")
Set objWorkBook = objExcel.Workbooks.Open("C:\clicktest.xls")
Set objWorksheet = objWorkBook.Worksheets("Sheet1")
objWorksheet.Cells(1, 1).Formula = "=B1+C1"
objWorkBook.Close SaveChanges:=True
objExcel.Quit
Set objWorksheet = Nothing
Set objWorkBook = Nothing
Set objExcel = Nothing
Exit Sub
ErFix:
On Error GoTo 0
MsgBox "XLap error(4)"
objExcel.DisplayAlerts = False
objExcel.Quit
Set objWorksheet = Nothing
Set objWorkBook = Nothing
Set objExcel = Nothing
End Sub

Sub RemoveFormula()
Dim objExcel As Object, objWorkBook As Object
Dim objWorksheet As Object

On Error GoTo ErFix
Set objExcel = CreateObject("EXCEL.APPLICATION")
Set objWorkBook = objExcel.Workbooks.Open("C:\clicktest.xls")
Set objWorksheet = objWorkBook.Worksheets("Sheet1")
objWorksheet.Cells(1, 1).Formula = ""
objWorkBook.Close SaveChanges:=True
objExcel.Quit
Set objWorksheet = Nothing
Set objWorkBook = Nothing
Set objExcel = Nothing
Exit Sub
ErFix:
On Error GoTo 0
MsgBox "XLap error(5)"
objExcel.DisplayAlerts = False
objExcel.Quit
Set objWorksheet = Nothing
Set objWorkBook = Nothing
Set objExcel = Nothing
End Sub

[lucas]

Hi Tommy,
This is a little out of my league...
I may have to install vb6 again.....

When We going fishin?

[Dave]

Thanks Tommy for your input. That does seem like a simple solution that should work... but it doesn't. In the "real" project the insert formula section contains 9 lengthy formulas to insert which I assume takes a few seconds to accomplish (along with the opening of the XL file, the formula insertion, and then saving the file). I thought that perhaps the formula insertion was generating a calculation event so I tried setting it to manual before formula insertion then returning to automatic...didn't work. I trialled my test XL file posted with the .exe file posted and couldn't seem to replicate my difficulties even though running the program from VB6 does create the same difficulties as previously stated. I'm going to trial combining the insert formula routine into the command button routine. Dave

[Tommy]

So it is not about the double-click of the button? I got the same problems but I was short sighted and narrow minded because I was looking at the button click. I'll look at it again tonight, I'm under the gun all the time at work.

Hey Steve, :hi:

I was up in Dallas last week training and installing new hardware and software. Started to give you a shout but things (as usual) got stretched out longer than I wanted so I had to come back late.

[Dave]

Tommy your vision is 20/20... it is about the double click. Apologies for the confusion. Just trialling different ways to thwart this annoying problem. Combining the insert formula routine into the command button click code seems worse (ie. you must use the task manager to stop the XL application before the same error will clear). This seems like more efficient code but the double click result is worse? Dave

Private Sub command1_Click()
Dim objExcel As Object, objWorkBook As Object
Dim objWorksheet As Object

Form1.Hide

On Error GoTo ErFix
Set objExcel = CreateObject("EXCEL.APPLICATION")
Set objWorkBook = objExcel.Workbooks.Open("C:\clicktest.xls")
Set objWorksheet = objWorkBook.Worksheets("Sheet1")
objWorksheet.Cells(1, 1).Formula = "=B1+C1"
objExcel.Run "showuserform1"
objExcel.DisplayAlerts = False
objExcel.Quit
Set objWorkBook = Nothing
Set objExcel = Nothing
Call RemoveFormula
Form1.Command1.BackColor = RGB(0, 128, 64) 'green
Form1.Show
Exit Sub

ErFix:
On Error GoTo 0
MsgBox "XLap error(3)"
objExcel.DisplayAlerts = False
objExcel.Quit
Set objWorkBook = Nothing
Set objExcel = Nothing
Call RemoveFormula
Form1.Command1.BackColor = RGB(0, 128, 64) 'green
Form1.Show
End Sub

[Tommy]

The problem is in the
objWorkBook.Close SaveChanges:=True doesn't work, at least the way I thought it would so ....


objWorkBook.Save
objWorkBook.Close

LOL I tested with the code I posted earlier I also made some functions to open excel and close excel so it would be easier to debug. The project is attached.

You could import the userform to vb6 if you wanted.

EDIT: Added attachment

[Dave]

Tommy you need to do this for full effect...

'objExcel.Visible = True

My testing... quickly clicking the form button more than once hides the VB6 form then shows the XL app userform (until closed by selecting the quit button), but then continues on showing the VB6 again and then the XL userform...without clicking the VB6 botton again (auto like). This continues on for the number of clicks...trialled 2-4 clicks....if you really get carried away clicking fast you can still generate that error. The code is much improved to my previous attempts (doesn't crash nearly as easy). Thanks for your continuing time and efforts. I'm going to trial a few more things. Dave

[Tommy]

The reason for the visible = True is to make sure the code was workong and I didn't have to do the 3 finger salute to get rid of all the instances. :devil2:

I can't click it that fast. I would suggest at this time to make a global variable in the form level and not execute the macro if it is less than a second.

I pick the button as fast as I can but I couldn't catch but 1 at a time. It does process the InsertFormula, RemoveFormula, and show a user form, each one closing and saving the test spreadsheet from 1 click.:dunno

[Dave]

Thanks again Tommy for your help. I should have mentioned that "5" in the XL userform textbox indicated formula insertion success. Strange that my continued test findings of quickly clicking the VB6 form button while it is visible, produces the show XL userform.. on "quit"(XL userform command button) shows the VB6 form and auto clicks the command button to again hide the VB6 form and then show the XL userform. This cycles for each initial VB6 command click. The VB6 form command button looks disabled during this cycle. My pc glitch apparently. I'm not sure if I follow your suggestion re. global variables and not executing the macro if it's less than a second? If I come up with something that works for my pc, I will post. Dave

[Tommy]

Hey Dave,

The only way I could duplicate your problem is by:

Private Sub Form_Click()
Dim mI As Integer
For mI = 1 To 30
Command1_Click
Next
End Sub

But each click will process due to it will not iterate in the loop until the command1_click is finished.
The below is the timer. I removed the enabled and the color checks.

Private objExcel As Object
Private objWorkBook As Object
Private objWorksheet As Object
Private Clickcnt As Integer
Private HowLong As Long
Private Sub Command1_Click()
On Error GoTo ErFix
Clickcnt = Clickcnt + 1
If Abs(Timer - HowLong) > 5 Then ' wait for 5 seconds before allowing a new "RUN"
HowLong = Timer
Call InsertFormula
Form1.Hide
StrtXl "C:\clicktest.xls"
objExcel.Run "showuserform1"
ClsSvXl
Call RemoveFormula
Form1.Show
End If
MsgBox Clickcnt 'display the number of times this control has been clicked
Exit Sub
ErFix:
On Error GoTo 0
MsgBox "XLap error(3)"
MsgBox "You clicked: " & Clickcnt & " times!"
ClsSvXl
Call RemoveFormula
Form1.Show
End Sub
Sub InsertFormula()
On Error GoTo ErFix
StrtXl "C:\clicktest.xls"
objWorksheet.Cells(1, 1).Formula = "=B1+C1"
ClsSvXl
Exit Sub
ErFix:
On Error GoTo 0
MsgBox "XLap error(4)"
ClsSvXl
End Sub
Sub RemoveFormula()
On Error GoTo ErFix
StrtXl "C:\clicktest.xls"
objWorksheet.Cells(1, 1).Formula = ""
ClsSvXl
Exit Sub
ErFix:
On Error GoTo 0
MsgBox "XLap error(5)"
objExcel.DisplayAlerts = False
ClsSvXl
End Sub
Sub StrtXl(iPthNM As String)
On Error Resume Next
Set objExcel = GetObject("EXCEL.APPLICATION")
If Err.Number <> 0 Then
Err.Clear
Set objExcel = CreateObject("EXCEL.APPLICATION")
End If
objExcel.Visible = True
objExcel.DisplayAlerts = False

If OpenWorkBook(iPthNM) Then
'this is assuming that the sheet exist
Set objWorksheet = objWorkBook.Worksheets("Sheet1")
Else
Set objExcel = Nothing
End If
On Error GoTo 0
End Sub
Function OpenWorkBook(iPthNM As String) As Boolean
Dim mI As Long
If objExcel.Workbooks.Count > 0 Then
For mI = 0 To objExcel.Workbooks.Count
If objExcel.Workbooks(mI).Name = "clicktest.xls" Then
Set objWorkBook = objExcel.Workbooks(mI)
End If
Next
End If
On Error Resume Next
If objWorkBook Is Nothing Then Set objWorkBook = objExcel.Workbooks.Open(iPthNM)
If Err.Number <> 0 Then
MsgBox Err.Description
Err.Clear
Else
OpenWorkBook = True
End If
End Function
Function ClsSvXl() As Boolean
On Error Resume Next
objWorkBook.Save
objWorkBook.Close
objExcel.DisplayAlerts = True
objExcel.Quit
Set objWorksheet = Nothing
Set objWorkBook = Nothing
Set objExcel = Nothing
ClsSvXl = True
Err.Clear
On Error GoTo 0
End Function

[Dave]

Tommy if you do not make the XL application visible (as above somewhere) and comment out the message box...

' MsgBox Clickcnt 'display the number of times this control has been clicked

You should be able to replicate my problems. The code you posted works perfect until I made these changes... they best represent the actual conditions. The clickcnt is just being used to add some info re. this error. Anyways, I sure appreciate your help... I'm learning lots but if you want to throw in the towel, that's no problem. This hasn't been a fatal error so far, just an annoyance that I would like to resolve. Again, thanks. Dave

[Tommy]

Dave I commented the Visible. I wrote the number of times the button was clicked to the immediate window. I was able to replicate your problem. I changed the timer to 20 seconds. I threw away 15 clicks. With the posted code it would trhow away about 3-4 clicks per second. The fact that I clicked 40+ made the button macro run several times. Now the question is...... how many clicks do you want to throw away and how long in between allowable clicks do want to wait?
Other than changing the wait period to 20 seconds and writing to the immediate window instead of a msgbox and of course the excel.visible that I didn't post, this is the same code.

The modified code:

Private Sub Command1_Click()
On Error GoTo ErFix
Clickcnt = Clickcnt + 1
If Abs(Timer - HowLong) > 20 Then ' wait for 20 seconds before allowing a new "RUN"
HowLong = Timer
Debug.Print "Running......"
Call InsertFormula
Form1.Hide
StrtXl "C:\clicktest.xls"
objExcel.Run "showuserform1"
ClsSvXl
Call RemoveFormula
Form1.Show
End If
Debug.Print Clickcnt
Exit Sub
ErFix:
On Error GoTo 0
MsgBox "XLap error(3)"
MsgBox "You clicked: " & Clickcnt & " times!"
ClsSvXl
Call RemoveFormula
Form1.Show
End Sub

[Tommy]

Let me know what speed you PC is and I'll try to replicate if this doesn't work.

Private objExcel As Object
Private objWorkBook As Object
Private objWorksheet As Object
Private Clickcnt As Integer
Private WorkIt As Boolean
Private Sub Command1_Click()
'Dim Clickcnt As Integer
If WorkIt Then
WorkIt = False
Call InsertFormula
Form1.Hide
StrtXl "C:\clicktest.xls"
objExcel.Run "showuserform1"
ClsSvXl
Call RemoveFormula
End If
Form1.Show
Exit Sub
ErFix:
On Error GoTo 0
MsgBox "XLap error(3)"
MsgBox "You clicked: " & Clickcnt & " times!"
ClsSvXl
Call RemoveFormula
Form1.Command1.BackColor = RGB(0, 128, 64) 'green
Command1.Enabled = True '-Added
Form1.Show
End Sub
Sub InsertFormula()
On Error GoTo ErFix
StrtXl "C:\clicktest.xls"
objWorksheet.Cells(1, 1).Formula = "=B1+C1"
ClsSvXl
Exit Sub
ErFix:
On Error GoTo 0
MsgBox "XLap error(4)"
ClsSvXl
End Sub
Sub RemoveFormula()
On Error GoTo ErFix
StrtXl "C:\clicktest.xls"
objWorksheet.Cells(1, 1).Formula = ""
ClsSvXl
Exit Sub
ErFix:
On Error GoTo 0
MsgBox "XLap error(5)"
objExcel.DisplayAlerts = False
ClsSvXl
End Sub
Sub StrtXl(iPthNM As String)
On Error Resume Next
Set objExcel = GetObject("EXCEL.APPLICATION")
If Err.Number <> 0 Then
Err.Clear
Set objExcel = CreateObject("EXCEL.APPLICATION")
End If
objExcel.Visible = True
objExcel.DisplayAlerts = False

If OpenWorkBook(iPthNM) Then
'this is assuming that the sheet exist
Set objWorksheet = objWorkBook.Worksheets("Sheet1")
Else
Set objExcel = Nothing
End If
On Error GoTo 0
End Sub
Function OpenWorkBook(iPthNM As String) As Boolean
Dim mI As Long
If objExcel.Workbooks.Count > 0 Then
For mI = 0 To objExcel.Workbooks.Count
If objExcel.Workbooks(mI).Name = "clicktest.xls" Then
Set objWorkBook = objExcel.Workbooks(mI)
End If
Next
End If
On Error Resume Next
If objWorkBook Is Nothing Then Set objWorkBook = objExcel.Workbooks.Open(iPthNM)
If Err.Number <> 0 Then
MsgBox Err.Description
Err.Clear
Else
OpenWorkBook = True
End If
End Function
Function ClsSvXl() As Boolean
On Error Resume Next
objWorkBook.Save
objWorkBook.Close
objExcel.DisplayAlerts = True
objExcel.Quit
Set objWorksheet = Nothing
Set objWorkBook = Nothing
Set objExcel = Nothing
ClsSvXl = True
Err.Clear
On Error GoTo 0
End Function


Private Sub Form_Paint()
WorkIt = True
End Sub

[Dave]

That's probably the best so far... less code, no waiting, and you can click multiple times on the VB6 form without doing the error cycling phantom auto click thing that I started with... but it still needs the 3 finger salute if you happen to click between the VB6 form hiding and the XL form showing. That's probably a more serious problem than I started with as it used to eventually clear the error(s). Maybe a big sign on the VB6 form... "CLICK IT ONCE STUPID" maybe the answer? :rotlaugh: Thanks Tommy. Dave
ps. Tommy's code posted above this thread was in response to a PM. The previous code posted had worked very well but clicking between the VB6 form hiding and the XL form showing required the task manager's help.
pps. specs say 1.06 GH 256mb of ram.