ErrorHandler still showing error - vb6

When i type in text1 but it is wrong, the error is showing but the command2 is enabled. and when i enter the right name of my database. the error is still showing and the command2 is enabled again. i dont know what's happening.
Private Sub Command1_Click()
conAddStudent.ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID= 123 ;Initial Catalog=" & Text1.Text & " ;Data Source=COM1\SQLEXPRESS;password= 123"
On Error GoTo err
command2.Enabled = True
err:
MsgBox "none"
Exit Sub
End Sub

You need to move your Exit Sub up before the error label so it exits before firing the error on a good run.
Private Sub Command1_Click()
conAddStudent.ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID= 123 ;Initial Catalog=" & Text1.Text & " ;Data Source=COM1\SQLEXPRESS;password= 123"
If Text2.Text = "Valid Name" Then
Text2.Enabled = True
Else
MsgBox "none"
End If
End Sub

Related

My code for a Outlook 2016 attachment reminder doesn't display the correct dialog box

When I use this code:
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim retMB As Variant
Dim strBody As String
Dim iIndex As Long
On Error GoTo handleError
iIndex = InStr(Item.Body, "attach", "attachment")
If iIndex > 0 And Item.Attachments.Count = 1 Then
retMB = MsgBox("Forgot attachment?" & vbCrLf & vbCrLf & "Continue?", vbQuestion + vbYesNo + vbDefaultButton2 + vbMsgBoxSetForeground)
If retMB = vbNo Then Cancel = True
End If
handleError:
If Err.Number <> 0 Then
MsgBox "Sending with no attachments!" & Err.Description, vbExclamation, "ERROR!!!"
End If
End Sub
I want to get the "Forgot attachment?" dialog box with the message. Except I only get the "Sending with no attachments!" dialog box. Why doesn't the reminder dialog appear when the email doesn't have an attachment?
Your check must be Item.Attachments.Count = 0.

This VBS file is not working [duplicate]

I am trying to make the cancel function work for my array it works for a simple input box but Array(InputBox( does not like it very much.
Working code.
If strVarValue = vbNullString Then
MsgBox ("User canceled!")
WScript.Quit
End If
What I need help with
strIPAddress = Array(InputBox("IP address"))
If strIPAddress = vbNullString Then
MsgBox ("User canceled!")
WScript.Quit
End If
Doesn't like the Array hence why I'm getting type mismatch.
Do the conversion only if the user did not press "Cancel":
userInput = InputBox("IP address")
If userInput = "" Then
MsgBox ("User canceled!")
WScript.Quit
End If
strIPAddress = Array(userInput)
Also, if you want to distinguish between "user pressed Cancel" and "user pressed OK without entering a value" you need to check if the variable is Empty:
userInput = InputBox("IP address")
If IsEmpty(userInput) Then
MsgBox ("User canceled!")
WScript.Quit
ElseIf userInput = "" Then
MsgBox ("Missing input!")
WScript.Quit 1
End If
strIPAddress = Array(userInput)

TCPClient iFix error: Invalid Operation at Current State 40020

This is a continuation of my last post: How to read weight from scale using ethernet connection
After creating the TCP connection in vb10 - I am now trying to read the weight from the scale in iFix (vb6). The code below works if I create a breakpoint and step through: strdata takes the weight of the scale (51g at the moment). However, when i simply run the code, I get the error:
Invalid operation at current state 40020.
What i think is happening is something to do with how quickly it reads or trying to read multiple times. Any tips would be great.
TCPclient is referring to winsock, and frmclient refers to my form. The command "S" is the necessary command for the scale to grab the weight value. Thanks!
Public Sub test()
On Error GoTo errHandler
Dim strData As String
frmClient.tcpClient.LocalPort = 0
frmClient.tcpClient.Connect "192.168.0.1", 8000
'Dim i As Integer
' For i = 0 To 2000
' Debug.Print "connection status=" & frmClient.tcpClient.State
' If frmClient.tcpClient.State = 7 Then
' Exit For Next i
frmClient.tcpClient.SendData "S" & vbCrLf
frmClient.tcpClient.GetData strData
MsgBox ("weight =" & strData)
'Exit Sub
errHandler:
MsgBox Err.Description & " " & Err.Number
'Resume Next
End Sub
Use the DataArrival event of your Winsock Control.
So something like:
' ... in your "frmClient" Form ...
Private Sub tcpClient_DataArrival(ByVal bytesTotal As Long)
Dim strData As String
tcpClient.GetData strData, vbString
MsgBox ("weight =" & strData)
End Sub
*Obviously removing the GetData() call in your original test() method.
Got it working! The code is below. I created a picture sub to initialize the ports/IP at the beginning of the code execution and then to close the connection at the end. I made a timer to automatically read the weight upon stabilization, so the weight can be found by clicking the button, or simply waiting 2 seconds (2000ms). Best of luck and thanks for the help!
Public tcpC As New Winsock
Private Sub CFixPicture_Close()
tcpC.Close
End Sub
Private Sub CFixPicture_Initialize()
tcpC.LocalPort = 0
tcpC.Connect "192.168.0.1", 8000
End Sub
Private Sub CommandButton1_Click()
On Error GoTo errHandler
Dim strData As String
tcpC.SendData "S" & vbCrLf
tcpC.GetData strData
Text4.Caption = "Weight: " & strData
Exit Sub
errHandler:
MsgBox "error:" & Err.Description
End Sub
Private Sub readScale_OnTimeOut(ByVal lTimerId As Long)
Dim strData As String
tcpC.SendData "S" & vbCrLf
tcpC.GetData strData
Text4.Caption = "Weight: " & strData
Exit Sub
End Sub

Pop up alert vb 6

Can someone help me. I'm having a hard time with this. All I need is to display an alert message whenever the medicines expired.My problem is when I got two or more expired medicines it doesn't alert all.Instead it alerts one medicine.Please help.
here is my code
Private Sub Form_Activate()
On Error Resume Next
With Main
.Text4 = Adodc1.Recordset.Fields("MedicineName")
.Text1.Text = Adodc1.Recordset.Fields("genericname")
.Text3.Text = Adodc1.Recordset.Fields("StockQuantity")
.Combo3 = Adodc1.Recordset.Fields("Expmonth")
.Combo4 = Adodc1.Recordset.Fields("Expday")
.Combo5 = Adodc1.Recordset.Fields("Expyear")
End With
Dim expirationdate As Date
expirationdate = CDate(Combo3 & "/" & Combo4 & "/" & Combo5)
datepicker.Value = Format(Now, "MMM-DD-yyyy")
If datepicker > expirationdate Then
MsgBox Text4.Text & " is expired ", vbExclamation, "Warning!"
If MsgBox("Do you want to dispose " & Text4 & "?", vbQuestion + vbYesNo, "Message") = vbYes Then
Adodc1.Recordset.Delete
ElseIf vbNo Then
Exit Sub
End If
End If
End Sub
Private Sub Form_Load()
Adodc1.CommandType = adCmdUnknown
Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\clinic.mdb" & ";Persist Security Info=False"
Adodc1.RecordSource = "select * from inventory order by Expyear asc"
Adodc1.Refresh
Adodc1.Refresh
End sub
You need to loop through all of the records in your recordset. Currently, you're operating on the FIRST record only.
Do Until Adodc1.Recordset.EOF
' Assign values to textboxes, test date, etc.
' Fetch the next record...
Adodc1.Recordset.MoveNext
Loop
Bond is correct, you need to iterate over your recordset to display the message for each record that is expired.
Private Sub Form_Activate()
Dim expirationdate As Date
On Error Resume Next '<-- this is going to cause a problem if you never check for errors
Adodc1.Recordset.MoveFirst 'make sure the control is positioned on the first record
Do While Adodc1.Recordset.EOF = False 'loop over all of the records
With Main
.Text4.Text = Adodc1.Recordset.Fields("MedicineName")
.Text1.Text = Adodc1.Recordset.Fields("genericname")
.Text3.Text = Adodc1.Recordset.Fields("StockQuantity")
.Combo3 = Adodc1.Recordset.Fields("Expmonth")
.Combo4 = Adodc1.Recordset.Fields("Expday")
.Combo5 = Adodc1.Recordset.Fields("Expyear")
End With
expirationdate = CDate(Combo3 & "/" & Combo4 & "/" & Combo5)
datepicker.Value = Format(Now, "MMM-DD-yyyy")
If datepicker > expirationdate Then
MsgBox Text4.Text & " is expired ", vbExclamation, "Warning!"
If MsgBox("Do you want to dispose " & Text4 & "?", vbQuestion + vbYesNo, "Message") = vbYes Then
Adodc1.Recordset.Delete
End If
End If
Adodc1.Recordset.MoveNext
Loop
End Sub

how to lock a system login after 3 failed attempts in vb6?

I already made security login that if failed 3 times the program will be terminated. However, I want to make a security login that will lock the system and the admin will be required to login instead.
Here's my code:
Dim nCnt As Integer
Dim nCnt2 As String
Private Sub cmdOk_Click()
nUsername = "username ='" & txtUsername.Text & "'"
npassword = txtPassword.Text
If nCnt < 2 Then
With adoLog.Recordset
.MoveFirst
.Find nUsername
If .EOF Then
MsgBox "Access Denied" & vbCrLf & "Please try again." & vbCrLf & vbCrLf & "Warning: You only have " & nCnt2 & " attempt.", vbCritical, "Terror"""
nCnt = nCnt + 1
nCnt2 = nCnt2 - 1
Label7.Caption = nCnt2
txtUsername.Text = ""
txtPassword.Text = ""
txtUsername.SetFocus
Else
If adoLog.Recordset.Fields("password").Value = npassword And adoLog.Recordset.Fields("flag").Value = 1 Then
Call Change_Flag
MsgBox "Access Granted"
cUser = adoLog.Recordset.Fields("name").Value
cPosition = adoLog.Recordset.Fields("position").Value
With adoHistory_Login.Recordset
.AddNew
.Fields("name").Value = cUser
.Fields("position").Value = cPosition
.Fields("time_login").Value = Time()
.Fields("date_login").Value = Date
.Fields("date_logout").Value = Date
.Update
Me.Refresh
frmMain.Show
frmMain.SetFocus
End With
Unload Me
txtUsername.Text = ""
txtPassword.Text = ""
Else
MsgBox "Access Denied" & vbCrLf & "Please try again." & vbCrLf & vbCrLf & "Warning: You only have " & nCnt2 & " attempt.", vbCritical, "Terror"""
nCnt = nCnt + 1
nCnt2 = nCnt2 - 1
Label7.Caption = nCnt2
txtUsername.Text = ""
txtPassword.Text = ""
txtUsername.SetFocus
End If
End If
End With
Else
Call block
End
End If
End Sub
Private Sub Change_Flag()
With adoLog.Recordset
.Fields("flag").Value = 0
End With
End Sub
Private Sub block()
MsgBox "You already used all attempt." & vbCrLf & "This will terminate the application.", vbCritical, "Terror"
End Sub
Private Sub Form_Initialize()
cmdOK.Enabled = False
txtPassword.Enabled = False
cmdRegister.Visible = False
If adoLog.Recordset.RecordCount <> 0 Then
cmdOK.Enabled = False
txtPassword.Enabled = False
txtUsername.Enabled = True
Else
cmdRegister.Visible = True
txtUsername.Enabled = False
End If
End Sub
Private Sub Form_Load()
nCnt2 = 2
Label7.Caption = nCnt2
End Sub
You will need to store an additional flag somewhere to indicate that login is denied and then check this flag before attempting the login. You will also need to store the account type and check to see if the account is allowed to log in even if this flag is set.
Are you wanting to lock out the full PC or the username that is being used?
Add a new column to the recordset for IsLocked and have it get set to true after the 3 logins (Make sure you provide some way for the admin to clear it back out though).
As soon as the username is used check IsLocked first before the password and kick it out immediately with the appropriate message.
Also, make sure you prevent the IsLocked from ever being set on the admin username.

Resources