Link to home
Start Free TrialLog in
Avatar of Jim P.
Jim P.Flag for United States of America

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:
dsquery user -limit 0 | dsget user -dn -samid -ln -fn -display -mustchpwd -canchpwd -pwdneverexpires -disabled -acctexpires  > \\192.168.1.2\LogonData\%COMPUTERNAME%_logonnames.txt

Open in new window


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  

Open in new window


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?
Avatar of David Todd
David Todd
Flag of New Zealand image

Hi,

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?
Avatar of Jim P.

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:
  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

Open in new window


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
Avatar of Jim P.

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.
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
Avatar of Jim P.

ASKER

Cap,

I don't think that will work because of this:
CN=Domain Support User1,OU=Domain Users

Open in new window


I'll try tomorrow.
jim,
post a sample text file
ASKER CERTIFIED SOLUTION
Avatar of datAdrenaline
datAdrenaline
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Jim P.

ASKER

datAdrenaline,

I'm using the Context Editor with characters showing. So they are all spaces.

I'll look at the code tomorrow.

Thanks
Avatar of Jim P.

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.


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

Open in new window

Avatar of Jim P.

ASKER

Thanks for a quick solution.