2012-05-23 222 views
3

我正在嘗試編寫一個VBA過程來搜索文本文件中的用戶名以查找用戶的IP地址。舉例來說,如果我搜索Chris Trucker,我希望在消息框中看到192.168.130.22VBA文本文件搜索

> 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 

回答

3

字符串函數以下是我會怎麼做:

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置於代碼頂部。

+0

+ 1尼斯一個JFC –

+0

+1,這也是一個很好的一個。 – Cylian

+0

感謝您的幫助 –

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 
+0

+1做得非常好。我建議你添加一個警告,這使用早期綁定到正則表達式庫 – brettdj

+0

+ 1我同意很好做:) –

+0

這個答案不*解決問題!無論您「迭代」多少,都無法從返回的「x」數組中檢索用戶的IP地址。我很驚訝@brettdj和@Sid沒有拿起這個。另外我測試了你的功能,而且它也不像廣告中那樣工作!你在'Next mt'之前缺少'position = position + 1'。 –

0

多麼美麗的分隔符的文本文件被稱爲!

假設你已經提供的文件格式,您在實際文件中存在的名稱傳遞,這個函數返回的任何名稱的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