Estou tentando fazer uma telinha de login , porem o TEXTBOX esta procurando o valor aleatorio no arquivo TXT todo , nao linha-a-linha o exato valor que eu quero para o login. E quando encontrasse o LOGIN e SENHA ja carregasse a TxtLevel do usuario para fazer o direcionamento de tela. Alguem me da uma ajuda?
Segue o anexo.
Código: Selecionar todos
Option Explicit
Private Sub UserForm_Initialize()
frmLogin.Width = 580
Call Check_UsersTXT
ComboBox1.AddItem "ADMINISTRATOR"
ComboBox1.AddItem "MANAGER"
ComboBox1.AddItem "OPERATOR"
End Sub
Private Sub Label19_Click() 'Label REGISTER
Frame1.Left = 588
Frame2.Left = 6 'Frame2 in evidence for register
BtnBack.Visible = True 'Makes the button BACK visible
BtnForgotPass.Visible = False 'Make the button FORGET PASSWORD invisible
Call Add_Counter 'ADD COUNTER
End Sub
Private Sub BtnBack_Click() 'Button BACK
Frame1.Left = 6 'Frame1 in evidence for login
Frame2.Left = 588
Frame3.Left = 1158
BtnBack.Visible = False ''Make the button BACK invisible
BtnForgotPass.Visible = True 'Make the button FORGET PASSWORD visible
End Sub
Private Sub BtnForgotPass_Click() 'Button Forgot Password
Frame1.Left = 1158
Frame3.Left = 6 'Frame2 in evidence for register
BtnBack.Visible = True ''Make the button BACK visible
BtnForgotPass.Visible = False 'Make the button FORGET PASSWORD invisible
End Sub
Private Sub TxtLogin_Change() 'MAKE SURE LOGIN IS VALID
Call SearchStringFileTXT
End Sub
Private Sub TxtLogin_Exit(ByVal Cancel As MSForms.ReturnBoolean) 'MAKE SURE LOGIN IS VALID
Call SearchStringFileTXT
End Sub
Private Sub TxtPassword_Change() 'MAKE SURE PASSWORD IS VALID
Call SearchPASSWORDFileTXT
End Sub
Private Sub TxtPassword_Exit(ByVal Cancel As MSForms.ReturnBoolean) 'MAKE SURE PASSWORD IS VALID
Call SearchPASSWORDFileTXT
End Sub
Private Sub TxtCadConfPass_Change() 'MAKE SURE PASSWORD IS THE SAME
If TxtCadConfPass.Text <> TxtCadPass.Text Then
Me.Label23 = "O"
Me.Label23.ForeColor = &HFF& 'red
Me.Label24 = "O"
Me.Label24.ForeColor = &HFF& 'red
If TxtCadConfPass.Text = "" Or TxtCadPass.Text = "" Then
Me.Label23 = "O"
Me.Label23.ForeColor = &HFF& 'red
Me.Label24 = "O"
Me.Label24.ForeColor = &HFF& 'red
Else
End If
Else
Me.Label23 = "O"
Me.Label23.ForeColor = &HFF00& 'green
Me.Label24 = "O"
Me.Label24.ForeColor = &HFF00& 'green
End If
End Sub
Private Sub TxtCadConfPass_(ByVal Cancel As MSForms.ReturnBoolean) 'MAKE SURE PASSWORD IS THE SAME
If TxtCadConfPass.Text <> TxtCadPass.Text Then
Me.Label23 = "O"
Me.Label23.ForeColor = &HFF& 'red
Me.Label24 = "O"
Me.Label24.ForeColor = &HFF& 'red
If TxtCadConfPass.Text = "" Or TxtCadPass.Text = "" Then
Me.Label23 = "O"
Me.Label23.ForeColor = &HFF& 'red
Me.Label24 = "O"
Me.Label24.ForeColor = &HFF& 'red
Else
End If
Else
Me.Label23 = "O"
Me.Label23.ForeColor = &HFF00& 'green
Me.Label24 = "O"
Me.Label24.ForeColor = &HFF00& 'green
End If
End Sub
Private Sub SearchStringFileTXT() 'SEARCH LOGIN IN USERS.TXT
Dim strFileName As String
strFileName = ThisWorkbook.Path & "\REGISTER\users.txt"
Dim strSearch As String
strSearch = TxtLogin.Text
Dim strLine As String
Dim f As Integer
Dim lngLine As Long
Dim blnFound As Boolean
f = FreeFile
Open strFileName For Input As #f
Do While Not EOF(f)
lngLine = lngLine + 1
Line Input #f, strLine
If InStr(1, strLine, strSearch, vbBinaryCompare) > 0 Then
'MsgBox "Search string found in line " & lngLine, vbInformation
Me.Label1 = "O"
Me.Label1.ForeColor = &HFF00& 'green
blnFound = True
Exit Do
End If
Loop
Close #f
If Not blnFound Then
'MsgBox "Search string not found", vbInformation
Me.Label1 = "O"
Me.Label1.ForeColor = &HFF& 'red
End If
End Sub
Private Sub SearchPASSWORDFileTXT() 'SEARCH PASSWORD IN USERS.TXT
Dim strFileName As String
strFileName = ThisWorkbook.Path & "\REGISTER\users.txt"
Dim strSearch As String
strSearch = TxtPassword.Text
Dim strLine As String
Dim f As Integer
Dim lngLine As Long
Dim blnFound As Boolean
f = FreeFile
Open strFileName For Input As #f
Do While Not EOF(f)
lngLine = lngLine + 1
Line Input #f, strLine
If InStr(1, strLine, strSearch, vbBinaryCompare) > 0 Then
'MsgBox "Search string found in line " & lngLine, vbInformation
Me.Label2 = "O"
Me.Label2.ForeColor = &HFF00& 'green
blnFound = True
Exit Do
End If
Loop
Close #f
If Not blnFound Then
'MsgBox "Search string not found", vbInformation
Me.Label2 = "O"
Me.Label2.ForeColor = &HFF& 'red
End If
End Sub
Private Sub BtnGo_Click()
If Me.Label1.ForeColor = &HFF& Or Me.Label2.ForeColor = &HFF& Or Me.Label1.ForeColor = &HFFFFFF Or Me.Label2.ForeColor = &HFFFFFF Then
lblMsg = "SOMETHING WRONG OR USER BLOCKED"
Application.Wait (Now + TimeValue("00:00:02")) 'APP WAIT 2 SECONDS
Else
BtnGo.Caption = "LOADING..."
BtnGo.BackColor = &H404040 'grey
Application.Wait (Now + TimeValue("00:00:02")) 'APP WAIT 2 SECONDS
End If
lblMsg = ""
End Sub
Private Sub TxtCadDateBirth_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) 'TEXTBOX FOR DATE
TxtCadDateBirth.MaxLength = 10 '10/10/2017
Select Case KeyAscii
Case 8 'Accept o BACK SPACE
Case 13: SendKeys "{TAB}" 'Emula o TAB
Case 48 To 57
If TxtCadDateBirth.SelStart = 2 Then TxtCadDateBirth.SelText = "/"
If TxtCadDateBirth.SelStart = 5 Then TxtCadDateBirth.SelText = "/"
Case Else: KeyAscii = 0 'Ignore others caracters
End Select
End Sub
Private Sub Check_UsersTXT() 'CHECK FILE USERS
Dim strPath As Variant
Dim strCheck As String
'CHECK FOLDERS AND FILES
strPath = ThisWorkbook.Path & "\REGISTER\users.txt"
If Dir(strPath) = vbNullString Then
strCheck = False
Call Create_UserTXT 'if the file NO exist do it.
Else
strCheck = True
'if the file exist do it. Nothing
End If
End Sub
Private Sub Create_UserTXT() 'CREATE FILE USER
Dim f As Integer
f = FreeFile
If Len(Dir(ThisWorkbook.Path & "\REGISTER", vbDirectory)) = 0 Then
MkDir ThisWorkbook.Path & "\REGISTER"
Open ThisWorkbook.Path & "\REGISTER\users.txt" For Output As #f
Close #f
'Open ThisWorkbook.Path & "\REGISTER\companies.txt" For Output As #f
'Close #f
'Open ThisWorkbook.Path & "\REGISTER\machines.txt" For Output As #f
'Close #f
'Open ThisWorkbook.Path & "\REGISTER\configurations.txt" For Output As #f
'Close #f
MsgBox "PERFECT"
End If
End Sub
Private Sub BtnSend_Click() ' BUTTON REGISTER NEW USERS
If TxtCadLogin = "" Or TxtCadName = "" Or TxtCadDateBirth = "" Or TxtCadPass = "" Or TxtCadConfPass = "" Or CheckBox1.Value = False Or ComboBox1.Value = "" Then
Label29.Caption = "ENTER ALL REQUIRED FIELDS AND CHECKBOX."
Application.Wait (Now + TimeValue("00:00:02")) 'APP WAIT 2 SECONDS
Label29.Caption = ""
Else
Call Add_Counter 'ADD COUNTER
SaveInfo VBA.Trim(TextBox1.Text) & "|" & VBA.Trim(TxtIdCompany.Text) & "|" & VBA.Trim(TxtCadLogin.Text) & "|" & VBA.Trim(TxtCadName.Text) & "|" & VBA.Trim(TxtCadDateBirth.Text) & "|" & VBA.Trim(TxtCadPass.Text) & "|" & VBA.Trim(TxtCadConfPass.Text) & "|" & VBA.Trim(ComboBox1.Text)
Call ClearFields
Label29.Caption = "NOW, YOU NEED TO WAIT FOR THE ADMINISTRATOR RELEASE."
Application.Wait (Now + TimeValue("00:00:02")) 'APP WAIT 2 SECONDS
Frame1.Left = 6 'Frame1 in evidence for login
Frame2.Left = 588
Frame3.Left = 1158
BtnBack.Visible = False 'Make the button BACK invisible
BtnForgotPass.Visible = True 'Make the button FORGET PASSWORD visible
Label29.Caption = ""
End If
End Sub
Private Sub SaveInfo(LogMessage As String) 'SAVE DATA
Dim LogFileName As String
Dim CheckFolder As String
Dim FileNum As Integer
CheckFolder = ThisWorkbook.Path & "\REGISTER" 'Set Path
LogFileName = CheckFolder & "\users.txt" 'Set file name
If Dir(LogFileName, vbNormal) <> "" Then 'If the file does not
If FileLen(LogFileName) Then LogMessage = vbNewLine & LogMessage 'exist, the same file is
End If 'created
FileNum = FreeFile
Open LogFileName For Append As #FileNum
Print #FileNum, LogMessage;
Close #FileNum
UserForm_Initialize
End Sub
Private Sub ClearFields() 'Clear Fields NEW USERS
TextBox1.Text = ""
TxtIdCompany = ""
TxtCadLogin = ""
TxtCadName = ""
TxtCadDateBirth = ""
TxtCadPass = ""
TxtCadConfPass = ""
CheckBox1.Value = False
Label23.Caption = ""
Label24.Caption = ""
ComboBox1 = ""
End Sub
Private Sub Add_Counter() 'ADD COUNTER
Call Check_UsersTXT
Dim FileName As String
Dim FileNum As Integer
Dim Arr() As Variant
Dim r As Long
Dim data As String
'' *** Change path and file name to suit ***
FileName = ThisWorkbook.Path & "\REGISTER\users.txt"
FileNum = FreeFile
r = 1
Open FileName For Input As #FileNum
Do While Not EOF(FileNum)
Line Input #FileNum, data
ReDim Preserve Arr(1 To r)
Arr(r) = data
r = r + 1
Loop
Close #FileNum
If FileLen(FileName) <> 0 Then 'TEST IF BLANK TXT FILE
TextBox1.Text = Split(Arr(UBound(Arr)), "|")(0) + 1
Else
TextBox1.Text = 1
End If
End Sub