VBA Regex to Match IPV4 and IPV6

[sethae]

I'm trying to use VBA to scrape all IP addresses from all Excel files in a given user-selected folder. I have gotten this to work with the IPV4 addresses, but the couple IPV6 regex variations I've tried do not work. Does anyone have a tested IPV6 regex I can insert here?

    'Create regular expression to match IPV4 and IPV6 addresses
    Set ipRegex = CreateObject("VBScript.RegExp")
    ipRegex.Pattern = "\b(?:(?:25[0-5]|2[0-4][0-9]|1\d{2}|[1-9]?\d)\.){3}(?:25[0-5]|2[0-4][0-9]|1\d{2}|[1-9]?\d)\b"
    ipRegex.Global = True

 

[rakesh seebaruth]

try this

Sub GetIPAddresses()
   
    Dim TargetFolder As String
    Dim FileName    As String
    Dim FullPath    As String
    Dim RegexIPV4   As String
    Dim RegexIPV6   As String
    Dim IPV4Matches As Object
    Dim IPV6Matches As Object
    Dim IPV4Address As String
    Dim IPV6Address As String
    Dim IPV4Addresses As String
    Dim IPV6Addresses As String
    Dim IPV4Count   As Integer
    Dim IPV6Count   As Integer
    Dim I           As Integer
   
    TargetFolder = InputBox("Please enter the path of the folder you wish To search:")
    FileName = Dir(TargetFolder & "*.xlsx")
    RegexIPV4 = "\b(?:(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.){3}(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\b"
    RegexIPV6 = "\b(([0-9A-Fa-f]{1,4}:){7}[0-9A-Fa-f]{1,4})\b"
    IPV4Addresses = ""
    IPV6Addresses = ""
    IPV4Count = 0
    IPV6Count = 0
   
    While Len(FileName) > 0
        FullPath = TargetFolder & FileName
        Set IPV4Matches = CreateObject("VBScript.RegExp")
        IPV4Matches.Pattern = RegexIPV4
        Set IPV6Matches = CreateObject("VBScript.RegExp")
        IPV6Matches.Pattern = RegexIPV6
        IPV4Matches.Global = TRUE
        IPV6Matches.Global = TRUE
       
        IPV4Matches.IgnoreCase = TRUE
        IPV6Matches.IgnoreCase = TRUE
       
        Set FoundIPV4Matches = IPV4Matches.Exec
        Set FoundIPV6Matches = IPV6Matches.Exec
       
        For I = 0 To FoundIPV4Matches.Count - 1
            IPV4Address = FoundIPV4Matches.Item(I).Value
            IPV4Addresses = IPV4Addresses & IPV4Address & vbCrLf
            IPV4Count = IPV4Count + 1
        Next
       
        For I = 0 To FoundIPV6Matches.Count - 1
            IPV6Address = FoundIPV6Matches.Item(I).Value
            IPV6Addresses = IPV6Addresses & IPV6Address & vbCrLf
            IPV6Count = IPV6Count + 1
        Next
       
        MsgBox ("IPV4 Addresses Found: " & IPV4Count & vbCrLf & IPV4Addresses & vbCrLf & vbCrLf & "IPV6 Addresses Found: " & IPV6Count & vbCrLf & IPV6Addresses)
       
    End Sub