VBA文本文件搜索

Question

我正在尝试编写一个VBA过程来搜索文本文件中的用户名以查找用户的IP地址。举例来说，如果我搜索Chris Trucker，我希望在消息框中看到192.168.130.22。

> 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 

试过以下，但它的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

字符串函数以下是我会怎么做：

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 

正如你看到的，如果没有找到用户名这个函数抛出一个错误。

请注意，此功能允许您以长格式（Chris Trucker）或简写格式（Truckerc）或甚至时间戳（2012-05-18 17:28:11）搜索用户名。但请注意，如果您的搜索字词有多个实例，则只会返回与第一个实例对应的IP地址。如果您想要返回所有实例，则可以调整代码。

作为最终评论，建议始终声明所有变量，并强制自己通过将Option Explicit置于代码顶部。

Answer 2

你必须创建一个FileSystemOject并调用ReadLine方法。 就是这样的。

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

通过传递“”作为参数获得IP地址和名称调用InStr函数。在vibscript

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

Answer 3

功能

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 

可能受

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

Answer 4

多么美丽的分隔符的文本文件被称为！

假设你已经提供的文件格式，您在实际文件中存在的名称传递，这个函数返回的任何名称的IP地址，你提供：

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 

使用此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 

用法示例：

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

如果名称不存在于目标文件中，当然会抛出错误（运行时错误9）。

另一种可能的方法，包括：

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 

还采用从Charley Kyd's website的功能。

这个比较好一点，因为如果找不到搜索项，它将不会抛出错误，它只会返回一个空值，您需要在调用代码中测试该值。像Jean的代码一样，它也允许您搜索任何术语，而不仅仅是用户名。

用法示例：

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