Validating user name with global user list in VBA - vba

I'm trying to create a an excel to track production in my organization. I have a user list with user names (windows). I wanted to validate the user name with the global list of the company whenever some adds a new user name to the list.

I have got a simple function for the same
Function GetUserFullName(userName) As String
Set WSHnet = CreateObject("WScript.Network")
UserDomain = WSHnet.UserDomain
On Error GoTo Err_open_esy
Set objUser = GetObject("WinNT://" & UserDomain & "/" & userName & ",user")
Exit_open_esy:
GetUserFullName = objUser.FullName
Exit Function
Err_open_esy:
GetUserFullName = "Error"
End Function
can use as
GetUserFullName("abc")

Related

Auto insert individual members' names and their amounts into a message body and send as SMS to their corresponding numbers

This question is about BulkSMS Messaging.
Sending the same message to different contacts is successful. The problem is, how can i personalized the message to send to their respective recipients.
For instance, in sending the message, i would like an access vba code to auto insert the individual members' names and their amounts into the message body and send to their corresponding numbers.
Something like this; (Dear [NameField], your [AmountField] has been received. Thank you.)
Updated:
The sSendMessage procedure below is what I call to send my messages. The way it works is like, there is a button that when clicked it populates the ttcontact textbox with MembersNumbers. The user then typed the message in the ttmessage textbox and in sending it then uses sSendMessage procedure to send the message in the ttmessage to the contacts in the ttcontacts.
Ever since you (# Applecore) responded to my question, I have been trying how to work around it but don’t know where to start. This time around too, there will be no ttmessage and ttcontact for the user to typed data, every info will be selected from the tblMember table and uniquely sent to their respective contacts. Can you please possibly look at my sSendMessages and check how it can be called by the sSend2Member to send the message row by row till it gets to the last record.
Private Sub sSendMessages()
Dim myURL As String
Dim sender As String
Dim contact As String
Dim msg As String
Dim postData As String
Dim winHttpReq As Object
apikey = "xxxxxxxxxxxxx"
sender = Me.ttSender.Value
contact = Me.ttContact.Value
msg = Me.ttMessage.Value
Set winHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
myURL = "https://apps.mnotify.net/smsapi?key=" & apikey & "&to=" & contact & "&msg=" & msg & "&sender_id=" & sender
postData = "key=" + apikey _
+ "&to=" + contact _
+ "&msg=" + msg _
+ "&sender_id=" + sender
winHttpReq.Open "POST", myURL, False
winHttpReq.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
winHttpReq.send (postData)
SendSMS = winHttpReq.ResponseText
MsgBox SendSMS
End If
End Sub
If you have already created a procedure that sends a message (for example sSendMessage), you can modify it to accept the number and message. You can then have some code like this which accepts the ID field from the table of members and then calls sSendMessage:
Sub sSend2Member(lngMember As Long)
On Error GoTo E_Handle
Dim db As DAO.Database
Dim rsData As DAO.Recordset
Dim strMsg As String
Set db = DBEngine(0)(0)
Set rsData = db.OpenRecordset("SELECT * FROM tblMember WHERE MemberID=" & lngMember)
If Not (rsData.BOF And rsData.EOF) Then
strMsg = "Dear " & rsData!MemberName & ", "
strMsg = strMsg & "your " & Format(rsData!MemberAmount, "#0.00") & " has been received. Thank you."
Call sSendMessage(rsData!MemberNumber, strMsg)
End If
sExit:
On Error Resume Next
rsData.Close
Set rsData = Nothing
Set db = Nothing
Exit Sub
E_Handle:
MsgBox Err.Description & vbCrLf & vbCrLf & "sSend2Member", vbOKOnly + vbCritical, "Error: " & Err.Number
Resume sExit
End Sub
If you are sending to 6 members, then you would call this procedure with each of the 6 MemberIDs.
Regards,

Defining and calling a global variable in VBA

I have a login screen which compares data via a Dlookup in order to authenticate users. I would like to create a global variable upon a correct login that any form on the database can call on and then open a form based on what that value is. So currently I have everything set up as such.
LOGIN FORM :
Option Compare Database
Public gstrUsr As String
LOGIN FORM:
Public Sub Command4_Click()
'Sets the login time to now and then authenticates user credentials
Dim usr As String
Me.Time = Now
Dim lvl As String
Dim lck As Integer
Dim sql As String
Dim msgapp As Integer
Dim chkusr As Variant
chkusr = Nz(DLookup("[Username]", "Login", "[Username]='" & Me.Username.Value & "'"), "")
msgapp = 0
usr = Nz(DLookup("[Password]", "Login", "[Username]='" & Me.Username.Value & "'"), "")
lvl = Nz(DLookup("[Level]", "Login", "[Username]='" & Me.Username.Value & "'"), "")
sql = "INSERT INTO Log ( [User], [Time] )SELECT [Forms]![Login]![Username] AS Expr1, [Forms]![Login]![Time] AS Expr2;"
''" & [Forms]![ItemList1]![SRCB] & "'"
'Runs above sql which adds a time record for the selected username also removes the "You are about to update X rows", will use this in the future on the accounting functions
If chkusr = "" Then msgapp = 1
If chkusr = "" Then MsgBox ("Invalid Credentials")
DoCmd.SetWarnings False
DoCmd.RunSQL (sql)
DoCmd.SetWarnings True
'If password is = to the value that is returned in the "usr" variable declared at the top via Dlookup it will open a form based on what that users "level" is otherwise displays and invalid credentials message box
Do While msgapp = 0
If usr = Me.Password.Value Then
lck = 1
msgapp = 3
Else
MsgBox ("Invalid Credentials")
msgapp = 3
End If
Loop
Do While lck = 1
If lvl = "2" Then
DoCmd.OpenForm "MainB"
gstrUsr = DLookup("[Username]", "Login", "[Username]='" & Me.Username & "'")
lck = 0
Else
DoCmd.OpenForm "Main"
lck = 0
End If
Loop
End Sub
FORM THAT LOADS AFTER SUCCESSFUL LOGIN: (Main form with buttons to get to other forms, I included a text box so I could see if the information is being passed to the second form)
Private Sub Form_Load()
Me.Text75 = gstrUsr
End Sub
How do I get the global variable to pass to the second form?
Define your public variable in a code module instead of the module of the form.
This way it'll be available from any module (if it's public)

VB.net COMExeption was unhandled

I am creating a user login system using vb.net and MS access. I am unsure what is going wrong with my system and I receive the error message "Item cannot be found in the collection corresponding to the requested name or ordinal" The error is coming up in the section "User.Find(Username)" on the first line of the DO loop. Here is my code:
Public Class Login
Dim LoginError As String ' This will tell the user what is wrong with his login
Public Function Login()
Dim DBConn As New ADODB.Connection ' This is how we tell visual studio
'how to connect to our database
Dim User As New ADODB.Recordset 'We pass our argument through our recordset
Dim Username As String 'This will be our "Query"
Dim strUserDB As String 'This get sets to the email field in our database.
Dim strPassDB As String 'Same as above just for the password
Dim blnUserFound As Boolean 'I will be using a "DO" loop so I will use
'this as my condition
DBConn.Open("Provider = Microsoft.Jet.OLEDB.4.0;" & _
"Data Source = '" & Application.StartupPath & "\UserDetails2000.mdb'")
'The inverted comas in the dataOuce statement as itt keeps the location of your
'file as one string.
User.Open("tblUserDetails", DBConn, ADODB.CursorTypeEnum.adOpenStatic, ADODB.LockTypeEnum.adLockOptimistic)
'This is my table 'This is my connection 'These are some settings
blnUserFound = False
Login = False
Username = "User = '" & txtEmail.Text & "'" 'This tells the database to find the email field
'Equivilent to what was entered in the textbox
Do
User.Find(Username) 'This is the full statement that sends my 'Query' to the record set
If User.BOF = False And User.EOF = False Then
'BOF = Begining of file, EOF = End of file, it tests whether the database has
'reached its sentinal value, if it hasent then the username has been found, If it has,
'the username has been found.
strUserDB = User.Fields("Email").Value.ToString
'"Email" is my table field. I am setting strUserDB to the username field of my table
strPassDB = User.Fields("Password").Value.ToString
If strUserDB <> txtEmail.Text Then
User.MoveNext()
'This IF statement handles different CASE usernames, Example, admin and AdMiN
'We use this if statement to differentiate between different CASE letters
Else
blnUserFound = True
If strPassDB = txtPassword.Text Then
User.Close()
DBConn.Close()
Return True
Else
LoginError = "Invalid Password"
User.Close()
DBConn.Close()
Return False
End If
End If
Else
LoginError = "Invalid Username"
User.Close()
DBConn.Close()
Return False
End If
Loop Until blnUserFound = True
LoginError = "Invalid Username"
User.Close()
DBConn.Close()
Return False
End Function
Private Sub btnLogin_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnLogin.Click
If Login() = True Then
MessageBox.Show("Login Succesful", "Login Status")
Else
MessageBox.Show(LoginError, "Login Status")
End If
End Sub
End Class
Verify that tblUserDetails contains a column named User.
Maybe User is also a reserved keyword in Access so try setting Username as:
Username = "[User] = '" & txtEmail.Text & "'"

VBScript error 424 Object Required when running script under SYSTEM account

I am trying to add a domain user account to a local group and everything works fine if I am logged into the computer but if I run the same script under the SYSTEM account it fails with the error: 424 Object Required". Here is the code:
Dim domain : domain = "DOMAIN01"
Dim domainController: domainController = "99.139.151.102"
Dim localComputer : localComputer = "SERVER001"
Dim localGroup : localGroup = "LocalGroup1"
Dim domainAccount : domainAccount = "User1"
Dim objLocalGroup
Dim objDomainUser
Set objLocalGroup = GetObject("WinNT://" & localComputer & "/" & localGroup & ",group")
Set objDomainUser = GetObject("WinNT:").OpenDSObject("WinNT://" & domain & "/" & domainController & "/" & domainAccount, domainAccount, "Password1234", ADS_SECURE_AUTHENTICATION or ADS_SERVER_BIND)
'Add domain user to local group.
objLocalGroup.Add(objDomainUser.ADsPath)
If Err.Number <> 0 Then
WScript.Echo Err.Number
WScript.Echo Err.Description
Else
WScript.Echo domainAccount & " has been added to local group " & localGroup
End If
Thank you
The SYSTEM account has no business connecting to other hosts. Run the script as a user with local admin privileges.

Determining a User's Group Membership

How can I determine if a user, in say Access, is a member of an Active Directory Security Group?
I'd rather not build a whole authentication system into my little Access DB.
Thanks
Allain found this online
Function IsMember(strDomain As String, strGroup _
As String, strMember As String) As Boolean
Dim grp As Object
Dim strPath As String
strPath = "WinNT://" & strDomain & "/"
Set grp = GetObject(strPath & strGroup & ",group")
IsMember = grp.IsMember(strPath & strMember)
End Function
You can get the Windows account info by way of the USERDOMAIN and USERNAME environment vars:
Function GetCurrentUser() As String
GetCurrentUser = Environ("USERNAME")
End Function
Function GetCurrentDomain() As String
GetCurrentDomain = Environ("USERDOMAIN")
End Function
Putting it all together:
If IsMember(GetCurrentDomain, "AD Group", GetCurrentUser) Then
DoStuff()
End If
I'm late to the game with this, but the code you need is below. It gets user names and domain names for you.
Note that I'm not using objGroup.Ismember - that's actually the correct method to use - I'm enumerating the list of groups that the user is in, because it's much easier to debug and there's no appreciable performance penalty.
...And I lifted the code from an earlier project, in which I needed to check membership of a 'Read Reports' group, an 'Edit Data' Group, and an 'Edit System Data' group, so that I could choose which controls to enable and which forms to open read-only. Enumerating groups once was faster than three separate checks.
Public Function UserIsInGroup(GroupName As String, _
Optional Username As String, _
Optional Domain As String) As Boolean
'On Error Resume Next
' Returns TRUE if the user is in the named NT Group.
' If user name is omitted, current logged-in user's login name is assumed.
' If domain is omitted, current logged-in user's domain is assumed.
' User name can be submitted in the form 'myDomain/MyName'
' (this will run slightly faster)
' Does not raise errors for unknown user.
'
' Sample Usage: UserIsInGroup( "Domain Users")
Dim strUsername As String
Dim objGroup As Object
Dim objUser As Object
Dim objNetwork As Object
UserIsInGroup = False
If Username = "" Then
Set objNetwork = CreateObject("WScript.Network")
strUsername = objNetwork.UserDomain & "/" & objNetwork.Username
Else
strUsername = Username
End If
strUsername = Replace(strUsername, "\", "/")
If InStr(strUsername, "/") Then
' No action: Domain has already been supplied in the user name
Else
If Domain = "" Then
Set objNetwork = CreateObject("WScript.Network")
Domain = objNetwork.UserDomain
End If
strUsername = Domain & "/" & strUsername
End If
Set objUser = GetObject("WinNT://" & strUsername & ",user")
If objUser Is Nothing Then
' Insert error-handler here if you want to report an unknown user name
Else
For Each objGroup In objUser.Groups
'Debug.Print objGroup.Name
If GroupName = objGroup.Name Then
UserIsInGroup = True
Exit For
End If
Next objGroup
End If
Set objNetwork = Nothing
Set objGroup = Nothing
Set objUser = Nothing
End Function
Hopefully this late submission is of use to other developers: when I looked this up for the first time, back in 2003, it was like nobody had ever used AD groups in Excel or MS-Access.
Found this online
Function IsMember(strDomain As String, strGroup _
As String, strMember As String) As Boolean
Dim grp As Object
Dim strPath As String
strPath = "WinNT://" & strDomain & "/"
Set grp = GetObject(strPath & strGroup & ",group")
IsMember = grp.IsMember(strPath & strMember)
End Function
Now, I only need the account name of the current user. Too bad Application.CurrentUser doesn't give me their Domain Account name.