VBA text file search

Question

I’m trying to write a VBA procedure that searches for usernames in a text file to find the user's IP address. So for example, given the input below, if I search Chris Trucker I want to see 192.168.130.22 in a message box.

> 192.168.2.151,Super Fly,ABC\Flys,2012-05-18 16:11:29 
> 192.168.2.200,Rain,ABC\rain,2012-05-17 15:42:05 
> 192.168.2.210,Snow,ABC\Snow,2012-05-16 08:24:39 
> 192.168.2.78,Wind,ABC\wind,2012-05-02 19:24:06 
> 192.168.130.21,Mike Jordan,ABC\Jordanm,2012-05-18 17:28:11 
> 192.168.130.22,Chris Trucker,ABC\Truckerc,2012-05-18 17:28:11 
> 192.168.130.23,Chris Jackson,ABC\JacksonC,2012-05-18 17:04:39

Tried the following but it's VBScript

Const ForReading = 1

Set objRegEx = CreateObject("VBScript.RegExp")
objRegEx.Pattern = "JacksonC"  

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("\\server\tsusers\Users.txt", ForReading)

Do Until objFile.AtEndOfStream
    strSearchString = objFile.ReadLine
    osakapc = Left(strSearchString,14)
    Set colMatches = objRegEx.Execute(strSearchString)

    If colMatches.Count = 1 Then 
        For Each strMatch in colMatches  


        Next
    End If
Loop

Answer 1

What a beautifully delimited text file!

Assuming the file format you have provided, and that you pass in a name that actually exists in the file, this function returns the IP address of any name you provide:

Function GetIPAddress(fileName As String, userName As String) As String

  Dim userinfo As String
  Dim tokens As Variant
  Dim laststring As Variant
  Dim userIP As String

  ' read text file into string
  userinfo = GetText(fileName)
  ' remove everything after the name we are looking for
  tokens = Split(userinfo, userName)(0)
  ' get the second-to-last comma-delimited value
  laststring = Split(tokens, ",")(UBound(Split(tokens, ",")) - 1)
  ' split by > and get second element
  userIP = Trim$(Split(laststring, ">")(1))

  GetIPAddress = userIP
End Function

Uses this function from Charley Kyd:

Function GetText(sFile As String) As String
  Dim nSourceFile As Integer, sText As String
  ''Close any open text files
  Close
  ''Get the number of the next free text file
  nSourceFile = FreeFile
  ''Write the entire file to sText
  Open sFile For Input As #nSourceFile
  sText = Input$(LOF(1), 1)
  Close
  GetText = sText
End Function

Sample Usage:

Sub testgetip()
  Debug.Print GetIPAddress("\\server\tsusers\Users.txt", "Chris Trucker")
End Sub

Will of course throw an error (run-time error 9) if the name does not exist in the target file.

Another possible method:

Function GetIPAddress(fileName As String, searchTerm As String) As String

  Dim userinfo As String
  Dim tokens As Variant
  Dim i As Long
  Dim userIP As String

  ' read text file into string
  userinfo = GetText(fileName)
  ' split text file by line breaks
  tokens = Split(userinfo, vbCrLf)

  ' loop through array and look for line that contains search term
  For i = LBound(tokens) To UBound(tokens)
    If InStr(tokens(i), searchTerm) > 0 Then  ' found it
      ' get first element of comma-split string, then second element of space-split string
      GetIPAddress = Split(Split(tokens(i), ",")(0), " ")(1)
      Exit For
    End If
  Next i
End Function

Also uses the function from Charley Kyd's website.

This one is a little better because it will not throw an error if the search term isn't found, it will simply return an empty value which you would need to test for in your calling code. Like Jean's code it also lets you search for any term, not just the username.

Sample Usage:

Sub testgetip()
  Dim ipaddr As String
  ipaddr = GetIPAddress("\\server\tsusers\Users.txt", "Trucker")

  If Len(ipaddr) = 0 Then
    MsgBox "Could not find IP address for that search term"
  Else
    Debug.Print ipaddr
  End If
End Sub

Answer 2

The function

Private Function ReturnNames(fPath$, pName$) As String
    'this This example uses **Microsoft VBScript Regular Expressions 5.5** and **Microsoft Scripting Runtime**
    Dim result$
    Dim re As New RegExp, fso As New FileSystemObject
    If fso.FileExists(fPath) = True Then
        Dim contents$, mt As Match, mts As MatchCollection
        contents = fso.OpenTextFile(fPath, ForReading).ReadAll
        With re
            .Global = True
            .MultiLine = True
            .Pattern = "^> *([^,\r\n]+),([^,\r\n]+),([^,\r\n]+),([^,\r\n]+)$"
            If .test(contents) = True Then
                Set mts = .Execute(contents)
                For Each mt In mts
                    If LCase(mt.SubMatches(1)) = LCase(pName) Then
                        result = mt.SubMatches(0)
                        Exit For
                    End If
                Next mt
            End If
        End With
        If result = "" Then
            result = "No matches found for '" & pName & "'."
        End If
    Else
        result = "File not found."
    End If

    ReturnNames = result

End Function

May be called by

Public Sub test000()
    MsgBox ReturnNames("C:\Documents and Settings\Patel_81\Desktop\1.txt", "Chris Trucker")
End Sub

Answer 3

Here's how I would do it:

Option Explicit

Sub tester()
    Dim inputFilePath As String
    inputFilePath = "\\server\tsusers\Users.txt"

    MsgBox GetUserIpAddress("Chris Trucker", inputFilePath) 
                            ' or "JacksonC" or "Bozo" or whatever

End Sub

Function GetUserIpAddress(whatImLookingFor As String, _
    inputFilePath As String)
    Const ForReading = 1

    Dim foundIt As Boolean
    Dim thisLine As String
    Dim ipAddress As String
    Dim FSO As Object
    Dim filInput As Object

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set filInput = FSO.OpenTextFile(inputFilePath, ForReading)

    foundIt = False
    Do Until filInput.AtEndOfStream
        thisLine = filInput.ReadLine
        If InStr(thisLine, whatImLookingFor) <> 0 Then
            foundIt = True
            ipAddress = Replace((Split(thisLine, ",")(0)), "> ", "")
            Exit Do
        End If
    Loop

    If foundIt Then
        GetUserIpAddress = ipAddress
    Else
        Err.Raise 9999, , _
            "I stiiiiiiiill haven't foooouuuund what I'm looking for."
    End If
End Function

As you see, this function throws an error if the user name isn't found.

Note that this function allows you to search for the user name in long form (Chris Trucker) or short form (Truckerc) or even the timestamp (2012-05-18 17:28:11). But be aware that if there are more than one instance of your search term, then only the IP address corresponding to the first instance will be returned. You can adapt the code if you want all instances to be returned.

As a final comment, it is advisable to always declare all of your variables and force yourself to do so by having Option Explicit at the top of your code.

Answer 4

You have to create a FileSystemOject and call the ReadLine method. Something Like this.

http://www.visualbasicscript.com/Vbscript-to-read-txt-file-for-input-m31649.aspx

To get the IP Address and name call InStr function by passing ',' as the parameter.

String functions in vibscript

http://www.w3schools.com/vbscript/vbscript_ref_functions.asp