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

功能

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 3

您必须创建一个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 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

VBA文本文件搜索

4 个答案: