How can I use VBA to get the email address of users on my network based on their Windows user name?
I have a log file that contains the UserName of everyone who launched this Access database. The username was generated from Environ("USERNAME") when they launched the database. I need to send an email to all recent users.
I don't need it to return the current users email address, and I don't need the code to send email.
I was wondering if it was possible using LDAP, but the example I have only works for the current logged in user. Is there another way?
Function GetEmailAddress(Optional strUserName As String = "") As String
' Get user's email address from LDAP
Dim sysInfo As Object
Dim oUser As Object
If strUserName = "" Then
' No name was passed in. Get it for the current user.
strUserName = Environ("USERNAME")
End If
' How I can I use strUserName to get the email address?
' The LDAP query below only works for the current logged in user.
Set sysInfo = CreateObject("ADSystemInfo")
Set oUser = GetObject("LDAP://" & sysInfo.UserName & "")
Debug.Print "Display Name: "; Tab(20); oUser.Get("DisplayName")
Debug.Print "Email Address: "; Tab(20); oUser.Get("mail")
Debug.Print "Computer Name: "; Tab(20); sysInfo.ComputerName
Debug.Print "Site Name: "; Tab(20); sysInfo.SiteName
Debug.Print "Domain DNS Name: "; Tab(20); sysInfo.DomainDNSName
GetEmailAddress = oUser.Get("mail")
Set sysInfo = Nothing
Set oUser = Nothing
End Function
Personally, I use the following function, though there are many possibilities.
Public Function GetMailAddress(strUsername As String) As String
Dim cmd As New ADODB.Command
Dim cn As New ADODB.Connection
Dim rs As ADODB.Recordset
cn.Open "Provider=ADsDSOObject;"
cmd.CommandText = "<LDAP://dc=MyCompany,dc=intranet>;(&(objectCategory=User)(CN=" & strUsername & "));mail;subtree"
cmd.ActiveConnection = cn
Set rs = cmd.Execute
GetMailAddress = rs.Fields(0).Value
End Function
You need to fill in the valid DC values for your LDAP server, of course.
Related
I use Kofax Transform to extract data from OCR.
For this i have a form with several inputs. Basically : name, surname, email.
My issue concerns the validation step.
I want to update the input fields on specific event (click on enter when the email field is selected and update the values from a database). On this database table I have 4 fields : id, name, surname and email
It's my first VBA expertience and I have to create a script:
Private Sub FillFormOneEmailValidated(ByVal pXDoc As CASCADELib.CscXDocument)
'define required properties
Dim rs As ADODB.Recordset
Dim cn As ADODB.Connection
Dim sqlRequest As String
Dim email As String
Dim dbHostServer As String
Dim dbUsername As String
Dim dbPassword As String
Dim dbName As String
Dim dbConnString As String
'Prapare the db connection
Set rs = New ADODB.Recordset : Set cn = New ADODB.Connection
dbHostServer = "127.0.0.1"
dbUsername = "root"
dbPassword = "root"
dbName = "dbtest"
'build the connection string and open connection to database
dbConnString = "Provider=MSDASQL;Driver={MySQL ODBC 5.3 Unicode Driver};
dbConnString = dbConnString & "Server=" & dbHostServer & ";"
dbConnString = dbConnString & "UID=" & dbUsername & ";"
dbConnString = dbConnString & "PWD=" & dbPassword & ";"
dbConnString = dbConnString & "database=" & dbName
'Create recordset and set conncetion
Set rs = New ADODB.Recordset : : Set cn = New ADODB.Connection
cn.ConnectionString = dbConnString
cn.Open
'build query
sqlRequest = "SELECT name, surname, email FROM users WHERE email = " & email
Set rs = cn.Execute(sqlRequest)
'iterate the values of the sql request
On Error Resume Next
rs.MoveFirst
pXDoc.Fields.ItemByName("name") = CStr(sqlRequest("name"))
rs.Close : Set rs = Nothing
cn.Close : Set cn = Nothing
End Sub
Here are my issues :
it seems that this code is not correct.
How can i "observe" an event on the email input (form) in KTA Transform ?
Avoid building sql query like that since its a potential injection risk. Look into using parameters. (Or hope nobody's kid is named bobby drop table, or be subject to a malicious user)
Also passwords in scripts are not recommended.
I'd look into the already built in functionalities of The database locator. And database dialog you can add to your validation mask.
If script is the only possible thing
You can use multiple events to to this. One way as you said is when the field is confirmed ValidationForm_AfterTableCellChanged.
You can see events available to you in the Project builder/Script editor by the dropdown options
enter image description here
Not sure for KTA, but in normal KT you can debug and observe other how methods are doing by enabling the Script debugging in the synchronization options.
The error in the script looks obvious
sqlRequest is your query as String variable. You must get your row data from the recordset. (i have not checked the rest of the script)
I have an Excel file that exports data into Word. It includes a cover page and grabs the user name ("First.Last") and changes it to "First Last" but I also need to include the user's professional title. This information is housed in an Access table. It has a field called Name and a field called Title. The Name field match exactly to User with no duplicates.
I have tried about eight different methods I've found online to grab this value from the table. The table will never happen to be open so I can't use "CurrentDB()".
I just need to be able to reach into the table in a database, grab the "title" value given that the value of the field "Name" is equal to the value of User (user name from the environment - the person using the excel file).
If it helps, I can provide examples of the different chunks of code I've used so far.
User is the username from the environment
tblPickName is the table I am trying to open
Path is the directory and file where the table is located
tblPickName has 2 fields, Name and Title
I need to grab the Title from this table and set it to my variable "Title" as long as Name equals User. Then I can export the username and title to Word along with the rest of the data.
Dim Path As String
Dim User As String
Dim Title As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
User = Environ("UserName")
User = Replace(User, ".", " ")
User = StrConv(User, vbProperCase)
Path = "Directory\Name.mdb"
Set db = DBEngine.OpenDatabase(Path)
Set rs = db.OpenRecordset("SELECT tblPickAnalyst.Title FROM tblPickAnalyst WHERE [Analyst]='" & User & "'")
Title = rs!Title
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
docWord.Bookmarks("AnalystName").Range.Text = User
docWord.Bookmarks("AnalystTitle").Range.Text = Title
Try this:
Public Sub JohnTayloristheBest()
Dim conAccess As ADODB.Connection
Set conAccess = New ADODB.Connection
Dim rdsAccess As ADODB.Recordset
Dim strTitle as String
With conAccess
.ConnectionString = "Data Source= **insert filepath here** "
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Open
End With
With rdsAccess
.Open "SELECT tblPickName.Title FROM tblPickName WHERE tblPickName.Name = '" & Environ("username") & "';", conAccess
If Not .EOF And Not IsNull(.fields(0)) Then
strTitle = .fields(0)
Else
Msgbox "Error: No record in the database for " & Environ("username")
End If
.Close
End With
conAccess.Close: conAccess = Nothing
End Sub
Be sure to select the correct references by doing this: http://msdn.microsoft.com/en-us/library/windows/desktop/ms677497(v=vs.85).aspx
Also, this is my first answer ever written on this site (or any other for that matter), so be kind.
Try this:
Public Function getTitle(name As String)
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = DBEngine.OpenDatabase("E:\Temp\Database.mdb")
Set rs = db.OpenRecordset("SELECT Title FROM tblPickName WHERE Name='" & name & "'")
If rs.RecordCount > 0 Then
getTitle = rs!Title
End If
rs.Close
db.Close
End Function
Ensure read access on table tblPickName (for Administrator)
Here is the final solution. Thank you to everyone who helped!
Dim Path As String
Dim User As String
Dim Title As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
User = Environ("UserName")
User = Replace(User, ".", " ")
User = StrConv(User, vbProperCase)
Path = "Directory\FileName"
Set db = DBEngine.OpenDatabase(Path)
Set rs = db.OpenRecordset("SELECT tblPickAnalyst.Title FROM tblPickAnalyst WHERE [Analyst]='" & User & "'")
Title = rs!Title
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
docWord.Bookmarks("AnalystName").Range.Text = User
docWord.Bookmarks("AnalystTitle").Range.Text = Title
I am trying to make use of information found in THIS POST.
I have 2 issues:
the following line hangs indefinitly. FIXED--- its just hidden and has no task bar item, simple search told me how to bring to to the front
strAddress = objWordApp.GetAddress(, strCode, False, 1, , , True, True).GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3A00001E")
I need to return something I can use in a TO line, so an ALIAS or a full email address. I have tested this code in WORD and it works perfrectly (remvoing the references to word) except I cannot get the correct information I need. When I pull I get an exchange distinguished name.. I need to convert this somehow to an alias or email address
/o=corperation/ou=administration/cn=my.name
BACKGROUND: the code in the previously mentioned post displayed the OUTLOOK GAL so a user can search/select a contact from it. I want to use the GAL because it can handle the 200,000+ records and includes distrobution lists.
SOFTWARE: This has to function within the OFffice 2010 suite. I don't need any backwords compatibility and future proofing is a minimal concern at the moment.
END RESULT: I basically just want a user to be able to search for a recipient and have that address end up in a cell.
Any hints would be greatly appreciated.
Method One: Using the GetAddress function
Does the following code still hang indefinitely for you?
Set objWordApp = CreateObject("Word.Application")
InputBox "", "", objWordApp.GetAddress(, "<PR_EMAIL_ADDRESS>", False, 1, , , True, True)
Method Two: If you know the username grab it directly
You can maybe use the LDAP directly to get this information:
Public Function GetUserEmail(ByVal userName As String) As String
Const ADS_SCOPE_SUBTREE = 2
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.CommandText = "SELECT mail FROM 'LDAP://DC=something,DC=co,DC=uk' WHERE objectCategory='user' AND sAMAccountName='" & userName & "'"
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
If Not objRecordSet.EOF Then
GetUserEmail = objRecordSet.Fields("mail").Value
Else
GetUserEmail = vbNull
End If
End Function
Method Three: Create your own searchable form
You could create your own UserForm to bring back a list of users from the LDAP. You could choose the fields you want to search on and then allow the user to click that item to grab the email address. It's a little messy, but it should load a bit faster, since it'll only search on a name more than 3 characters long.
In this example above I created a query which searches on the givenName or sn field of the LDAP:
Private Sub txtSearch_Change()
If Len(txtSearch) > 3 Then
queryString = txtSearch
Const ADS_SCOPE_SUBTREE = 2
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.CommandText = "SELECT givenName, sn, mail FROM 'LDAP://DC=something,DC=co,DC=uk' WHERE objectCategory='user' AND (givenName = '*" & queryString & "*' Or sn = '*" & queryString & "*')"
Set objRecordset = objCommand.Execute
lvResults.ListItems.Clear
Do Until objRecordset.EOF
Set li = lvResults.ListItems.Add(, , objRecordset.Fields("givenName").Value)
li.SubItems(1) = objRecordset.Fields("sn").Value
If Not IsNull(objRecordset.Fields("mail")) Then
li.SubItems(2) = objRecordset.Fields("mail").Value
End If
objRecordset.MoveNext
Loop
End If
End Sub
Notes
Something to note, is you will need to change the LDAP string to your company domain controller. For example LDAP://DC=something,DC=co,DC=uk.
If you don't know this you can find it out by doing:
Set sysinfo = CreateObject("ADSystemInfo")
MsgBox sysinfo.userName
Note you only want to take the DC= parts.
A list of all attributes can be found here: http://www.computerperformance.co.uk/Logon/LDAP_attributes_active_directory.htm
I want to run a vbs from a Visual Basic application and return the string back to the vb app. Google isn't hitting on much. Here is the vbs I want to run, and I want to pass the "ou" information back to the Visual Basic application as a string.
OPTION EXPLICIT
DIM objNetwork
DIM computerName
DIM ou
' Get the computerName of PC
set objNetwork = createobject("Wscript.Network")
'computerName = objNetwork.ComputerName
computername = Inputbox("Enter the network name of the PC to find :")
' Call function to find OU from computer name
ou = getOUByComputerName(computerName)
IF ou = "" THEN ou = "Not Found"
wscript.echo ou
function getOUByComputerName(byval computerName)
' *** Function to find ou/container of computer object from computer name ***
DIM namingContext, ldapFilter, ou
DIM cn, cmd, rs
DIM objRootDSE
' Bind to the RootDSE to get the default naming context for
' the domain. e.g. dc=HCHS,dc=co,dc=uk
set objRootDSE = getobject("LDAP://RootDSE")
namingContext = objRootDSE.Get("defaultNamingContext")
set objRootDSE = nothing
' Construct an ldap filter to search for a computer object
' anywhere in the domain with a name of the value specified.
ldapFilter = "<LDAP://" & namingContext & _
">;(&(objectCategory=Computer)(name=" & computerName & "))" & _
";distinguishedName;subtree"
' Standard ADO code to query database
set cn = createobject("ADODB.Connection")
set cmd = createobject("ADODB.Command")
cn.open "Provider=ADsDSOObject;"
cmd.activeconnection = cn
cmd.commandtext = ldapFilter
set rs = cmd.execute
if rs.eof <> true and rs.bof <> true then
ou = rs(0)
' Convert distinguished name into OU.
' e.g. cn=CLIENT01,OU=HCHS_Computers,dc=HCHS,dc=co,dc=uk
' to: OU=HCHS_Computers,dc=HCHS,dc=co,dc=uk
ou = mid(ou,instr(ou,",")+1,len(ou)-instr(ou,","))
getOUByComputerName = ou
end if
rs.close
cn.close
end function
Have you tried the ScriptControl?
See here:
http://msdn.microsoft.com/en-us/library/aa227413(v=vs.60)
http://support.microsoft.com/kb/184740
http://support.microsoft.com/kb/184739
http://www.techrepublic.com/article/make-your-vb-apps-scriptable-with-the-microsoft-windows-script-control/1045808
I want to reuse the Windows authentication to bind to the Active Directory user and check group membership.
I can get the Windows username with Environ("username"), but how do I get the password? I don't want to have to require the user to reenter their password, but there is no Environ("password").
How do I make this code work?
Thanks!
Private Sub ADsAuthenticate()
Dim objConnection As New ADODB.Connection
Dim objRecordset As ADODB.Recordset
Dim objADsUser As IADsUser
Dim objADsGroup As IADsGroup
Dim strUsername As String
Dim strPassword As String
strUsername = Environ("username")
strPassword = Environ("password")
With objConnection
.Provider = "ADsDSOObject"
.Properties("User ID") = strUsername
.Properties("Password") = strPassword
.Properties("Encrypt Password") = True
.Open "ADs Provider"
Set objRecordset = .Execute("<LDAP://<server>/dc=<domain>,dc=com>;" _
& "(sAMAccountName=" & strUsername & ");ADsPath;Subtree")
End With
With objRecordset
If Not .EOF Then
Set objADsUser = GetObject("LDAP:").OpenDSObject(.Fields("ADsPath").Value, strUsername, strPassword, ADS_SECURE_AUTHENTICATION)
Debug.Print objADsUser.ADsPath
For Each objADsGroup In objADsUser.Groups
Debug.Print objADsGroup.Name
Next
End If
End With
objConnection.Close
End Sub
What makes you so sure the password is anywhere to read in the first place?
The accepted way to keep passwords is to only store a one-way hash of password (typically using the BCrypt hashing algorithm plus a salt/nonce), and when someone logs in use the same hashing technique on the attempted password to see if it matches your stored value. Instead of storing something readable like password1 (warning: bad password example!) you end up storing something more like 23e598ac098da42== that's much less useful to crackers.
This is why if you lose a password most systems require you to reset it rather than recover the old one for you — they don't even have a real copy of the old one to give you.