Jim P.
asked on
How to split variable width data
I work with many individual domains (not in a forest) that I need to get a list of all users and dump it to text files.
The dsget statement I'm using is:
The statement works fairly well. It gives me the info I need. Now I am trying to pull the info into an Access DB and I'm finding out the columns are variable width as seen by the header lines below:
I want to automate the import into Access with VBA; but I am getting beat up on the variable column widths. I could probably get away with using the some sort of Excel
VBA functionality. Or for that matter does anyone know how to query Active Directory straight in to Access or SQL Server?
The dsget statement I'm using is:
dsquery user -limit 0 | dsget user -dn -samid -ln -fn -display -mustchpwd -canchpwd -pwdneverexpires -disabled -acctexpires > \\192.168.1.2\LogonData\%COMPUTERNAME%_logonnames.txt
The statement works fairly well. It gives me the info I need. Now I am trying to pull the info into an Access DB and I'm finding out the columns are variable width as seen by the header lines below:
dn samid fn ln display mustchpwd canchpwd pwdneverexpires acctexpires disabled
dn samid fn ln display mustchpwd canchpwd pwdneverexpires acctexpires disabled
dn samid fn ln display mustchpwd canchpwd pwdneverexpires acctexpires disabled
dn samid fn ln display mustchpwd canchpwd pwdneverexpires acctexpires disabled
I want to automate the import into Access with VBA; but I am getting beat up on the variable column widths. I could probably get away with using the some sort of Excel
VBA functionality. Or for that matter does anyone know how to query Active Directory straight in to Access or SQL Server?
ASKER
Can you pull the file into ta text processor and replace multiple spaces with just one space, or a comma or something?
I have users that look something like below:
Essentially the dn (Distinguished Name) will only have a single space separating it from the samid. So if I replace on a single space, I'll end up with a bunch of garbage.
PS Why post in SQL for a VBA/Access question?
In case someone else has a solution that will write directly to a SQL DB as well.
I have users that look something like below:
dn samid fn ln display mustchpwd canchpwd pwdneverexpires acctexpires disabled
CN=Domain Support User1,OU=Domain Users,DC=LongDomainName,DC=local user1 Domain Support User1 Domain Support User1 no yes yes never no
Essentially the dn (Distinguished Name) will only have a single space separating it from the samid. So if I replace on a single space, I'll end up with a bunch of garbage.
PS Why post in SQL for a VBA/Access question?
In case someone else has a solution that will write directly to a SQL DB as well.
Hi,
Based on the sample above, can't you use a fixed width import? If Access doesn't have, Excel has a pretty good one.
For import to SQL try the SSIS and data import wizards.
HTH
David
Based on the sample above, can't you use a fixed width import? If Access doesn't have, Excel has a pretty good one.
For import to SQL try the SSIS and data import wizards.
HTH
David
ASKER
If you look at the header lines in the the original post they vary depending on the name of domain and the names of the users in the domain.
I can't really post the various data results because that contains real user names and such. But the header lines can give you an idea of what I'm facing.
Or if you have a test domain and a production domain available you should be able to run the dsquery to see what I'm talking about as well.
I can't really post the various data results because that contains real user names and such. But the header lines can give you an idea of what I'm facing.
Or if you have a test domain and a production domain available you should be able to run the dsquery to see what I'm talking about as well.
try this codes
Dim s As String, j, xArr() As String
Open "c:\foldername\yrText.txt" For Input As #1
Do Until EOF(1)
Line Input #1, s
Debug.Print s
xArr = Split(s, " ")
For j = 0 To UBound(xArr)
If xArr(j) & "" <> "" Then
Debug.Print Trim(xArr(j))
End If
Next
'comment this next line if you get a single line and was parsed correctly
'to process the whole text file
Exit Do
Loop
Close #1
Dim s As String, j, xArr() As String
Open "c:\foldername\yrText.txt"
Do Until EOF(1)
Line Input #1, s
Debug.Print s
xArr = Split(s, " ")
For j = 0 To UBound(xArr)
If xArr(j) & "" <> "" Then
Debug.Print Trim(xArr(j))
End If
Next
'comment this next line if you get a single line and was parsed correctly
'to process the whole text file
Exit Do
Loop
Close #1
ASKER
Cap,
I don't think that will work because of this:
I'll try tomorrow.
I don't think that will work because of this:
CN=Domain Support User1,OU=Domain Users
I'll try tomorrow.
jim,
post a sample text file
post a sample text file
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
datAdrenaline,
I'm using the Context Editor with characters showing. So they are all spaces.
I'll look at the code tomorrow.
Thanks
I'm using the Context Editor with characters showing. So they are all spaces.
I'll look at the code tomorrow.
Thanks
ASKER
dat,
Here's the final code. I had to modify how I did the parsing to account for the fact that I'm also storing the source file name and the file date in the table to reflect how current the info is.
There are some accounts (guest, krbtgt, administrator) that have no first or last name and other things that throw off the parsing. I just delete them because we know they exist, and don't count towards the licensing.
Here's the final code. I had to modify how I did the parsing to account for the fact that I'm also storing the source file name and the file date in the table to reflect how current the info is.
There are some accounts (guest, krbtgt, administrator) that have no first or last name and other things that throw off the parsing. I just delete them because we know they exist, and don't count towards the licensing.
Public Function Import_AD_Info()
Dim SQL As String
Dim DB As DAO.Database
Dim RS As DAO.Recordset
Dim RS2 As DAO.Recordset
Dim Qry As DAO.QueryDef
Dim TableName As DAO.TableDef
Dim FieldName As DAO.Field
Dim FieldProperty As DAO.Property
Dim TblName As String
Dim FileNum As Integer
Dim FilePath As String
Dim FileName As String
Dim InputFile As String
Dim InputString As String
Dim I As Long
Dim DistinguishedNameStr As String
Dim SAMIDStr As String
Dim FirstNmStr As String
Dim LastNmStr As String
Dim DisplayNmStr As String
Dim MustChgPwdStr As String
Dim CanChgPwdStr As String
Dim PwdNeverExpiresStr As String
Dim AcctExpiresStr As String
Dim DisabledStr As String
Dim LastLogonStr As String
TblName = "ADListing"
If DoesTblExist(TblName) = True Then
DoCmd.SetWarnings False
DoCmd.DeleteObject acTable, TblName
DoCmd.SetWarnings True
End If
Set DB = CurrentDb()
Set TableName = DB.CreateTableDef(TblName)
With TableName
.Fields.Append .CreateField("FileName", dbText, 250)
.Fields.Append .CreateField("FileDate", dbDate)
.Fields.Append .CreateField("DistinguishedName", dbText, 250)
.Fields.Append .CreateField("SAMID", dbText, 50)
.Fields.Append .CreateField("FirstNm", dbText, 75)
.Fields.Append .CreateField("LastNm", dbText, 75)
.Fields.Append .CreateField("DisplayNm", dbText, 100)
.Fields.Append .CreateField("MustChgPwd", dbText, 15)
.Fields.Append .CreateField("CanChgPwd", dbText, 15)
.Fields.Append .CreateField("PwdNeverExpires", dbText, 15)
.Fields.Append .CreateField("AcctExpires", dbText, 15)
.Fields.Append .CreateField("Disabled", dbText, 15)
.Fields.Append .CreateField("LastLogon", dbText, 255)
End With
With TableName
.Fields("FileName").AllowZeroLength = True
.Fields("FileDate").AllowZeroLength = True
.Fields("DistinguishedName").AllowZeroLength = True
.Fields("SAMID").AllowZeroLength = True
.Fields("FirstNm").AllowZeroLength = True
.Fields("LastNm").AllowZeroLength = True
.Fields("DisplayNm").AllowZeroLength = True
.Fields("MustChgPwd").AllowZeroLength = True
.Fields("CanChgPwd").AllowZeroLength = True
.Fields("PwdNeverExpires").AllowZeroLength = True
.Fields("AcctExpires").AllowZeroLength = True
.Fields("Disabled").AllowZeroLength = True
.Fields("LastLogon").AllowZeroLength = True
End With
DB.TableDefs.Append TableName
TblName = "HeaderLines"
If DoesTblExist(TblName) = True Then
DoCmd.SetWarnings False
DoCmd.DeleteObject acTable, TblName
DoCmd.SetWarnings True
End If
Set DB = CurrentDb()
Set TableName = DB.CreateTableDef(TblName)
With TableName
.Fields.Append .CreateField("FileName", dbText, 250)
.Fields.Append .CreateField("Header", dbMemo)
.Fields.Append .CreateField("IDNum", dbLong)
End With
With TableName
.Fields("FileName").AllowZeroLength = True
.Fields("Header").AllowZeroLength = True
.Fields("IDNum").Attributes = dbAutoIncrField
End With
DB.TableDefs.Append TableName
'Opening the table to write to
Set DB = CurrentDb()
Set RS = DB.OpenRecordset("ADListing") '<-- Change to your tablename
Set RS2 = DB.OpenRecordset(TblName) '<-- Change to your tablename
'Opening the file to read from
FilePath = "\\192.168.1.2\LogonData\"
FileName = Dir(FilePath & "*logonnames.txt")
Do Until FileName = ""
FileNum = FreeFile()
InputFile = FilePath & FileName '<-- Change to your folder and path
Open InputFile For Input Access Read Shared As #FileNum
Do While EOF(FileNum) = False
Line Input #FileNum, InputString
InputString = ParseMyFields(InputString)
If Left(InputString, 6) = " dn " Then
With RS2
.AddNew
!FileName = FileName
!Header = InputString
.Update
End With
End If
If InStr(1, InputString, "samid") = 0 And InputString <> "dsget succeeded" Then
With RS
.AddNew
!FileName = FileName
!FileDate = FileDateTime(FilePath & FileName)
!DistinguishedName = GetElement(InputString, 0, "|")
!SAMID = GetElement(InputString, 1, "|")
!FirstNm = GetElement(InputString, 2, "|")
!LastNm = GetElement(InputString, 3, "|")
!DisplayNm = GetElement(InputString, 4, "|")
!MustChgPwd = GetElement(InputString, 5, "|")
!CanChgPwd = GetElement(InputString, 6, "|")
!PwdNeverExpires = GetElement(InputString, 7, "|")
!AcctExpires = GetElement(InputString, 8, "|")
!Disabled = GetElement(InputString, 9, "|")
'!LastLogon = Trim(Mid(InputString, 73, 20))
.Update
End With
End If
Loop
Close #FileNum
FileName = Dir()
Loop
RS.Close
RS2.Close
DB.Close
SQL = "DELETE * FROM ADListing " & _
"WHERE FirstNm in ('No', 'yes') " & _
"AND PwdNeverExpires in ('No', 'yes')"
DoCmd.SetWarnings False
DoCmd.RunSQL SQL, False
DoCmd.SetWarnings True
End Function
Public Function ParseMyFields(strData As String) As String
Dim strTemp As String: strTemp = Trim(strData)
'Replace double spaces
Do Until InStr(1, strTemp, " ", vbTextCompare) = 0
strTemp = Replace(strTemp, " ", "|")
Loop
'Replace double pipes
Do Until InStr(1, strTemp, "||", vbTextCompare) = 0
strTemp = Replace(strTemp, "||", "|")
Loop
'Return the result
ParseMyFields = strTemp
End Function
Public Function GetElement(strCSVToParse As String, ByVal lngElement As Long, strSeparator As String) As String
'Returns the text of an element within a CSV, note that intElement is ZERO based meaning that
'the FIRST element is element 0. Note that the last element is returned if the element
'requested is greater that what is available.
Dim aStrElement() As String
'Split every thing up
aStrElement = Split(strCSVToParse, strSeparator, , vbTextCompare)
'Make sure requested is within range
If UBound(aStrElement) < lngElement Then lngElement = UBound(aStrElement)
If 0 > lngElement Then lngElement = 0
'Return the result
GetElement = Trim(aStrElement(lngElement))
End Function
ASKER
Thanks for a quick solution.
Can you pull the file into ta text processor and replace multiple spaces with just one space, or a comma or something?
Just my first thoughts.
Regards
David
\
PS Why post in SQL for a VBA/Access question?