I am trying to implement a piece of vba code I found on the web to run a reverse DNS (NSLookup) from an IP address.
However whenever I call the function I am receiving an error
Compile Error
Expected Sub, Function or Property
Could one of the experts please take a look over the code for any obvious errors?
Thanks
However whenever I call the function I am receiving an error
Compile Error
Expected Sub, Function or Property
Could one of the experts please take a look over the code for any obvious errors?
Thanks
Code:
Private Sub DNSLookup_Click()
Range("C2:C10000").Select
Selection.ClearContents
Range("A2").Select
For x = 2 To Sheets("Sheet1").Range("A10000").End(xlUp).Row
Dim IPAddy As String
IPAddy = Sheets("Sheet1").Cells(x, 1).Value
Sheets("Sheet1").Cells(x, 3) = NSLookup (IPAddy)
Next x
End Sub
Code:
Public Function NSLookup(lookupVal As String, Optional addressOpt As Integer) As String
Const ADDRESS_LOOKUP = 1
Const NAME_LOOKUP = 2
Const AUTO_DETECT = 0
'Skip everything if the field is blank
If lookupVal <> "" Then
Dim oFSO As Object, oShell As Object, oTempFile As Object
Dim sLine As String, sFilename As String
Dim intFound As Integer
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oShell = CreateObject("Wscript.Shell")
'Handle the addresOpt operand
'Regular Expressions are used to complete a substring match for an IP Address
'If an IP Address is found, a DNS Name Lookup will be forced
If addressOpt = AUTO_DETECT Then
ipLookup = FindIP(lookupVal)
If ipLookup = "" Then
addressOpt = ADDRESS_LOOKUP
Else
addressOpt = NAME_LOOKUP
lookupVal = ipLookup
End If
'Do a regular expression substring match for an IP Address
ElseIf addressOpt = NAME_LOOKUP Then
lookupVal = FindIP(lookupVal)
End If
'Run the nslookup command
sFilename = oFSO.GetTempName
oShell.Run "cmd /c nslookup " & lookupVal & " > " & sFilename, 0, True
Set oTempFile = oFSO.OpenTextFile(sFilename, 1)
Do While oTempFile.AtEndOfStream <> True
sLine = oTempFile.Readline
cmdStr = cmdStr & Trim(sLine) & vbCrLf
Loop
oTempFile.Close
oFSO.DeleteFile (sFilename)
'Process the result
intFound = InStr(1, cmdStr, "Name:", vbTextCompare)
If intFound = 0 Then
NSLookup = ""
Exit Function
ElseIf intFound > 0 Then
'TODO: Cleanup with RegEx
If addressOpt = ADDRESS_LOOKUP Then
loc1 = InStr(intFound, cmdStr, "Address:", vbTextCompare) + InStr(intFound, cmdStr, "Addresses:", vbTextCompare)
loc2 = InStr(loc1, cmdStr, vbCrLf, vbTextCompare)
nameStr = Trim(Mid(cmdStr, loc1 + 8, loc2 - loc1 - 8))
ElseIf addressOpt = NAME_LOOKUP Then
loc1 = InStr(intFound, cmdStr, "Name:", vbTextCompare)
loc2 = InStr(loc1, cmdStr, vbCrLf, vbTextCompare)
nameStr = Trim(Mid(cmdStr, loc1 + 5, loc2 - loc1 - 5))
End If
End If
NSLookup = nameStr
Else
NSLookup = "N/A"
End If
End Function
Function FindIP(strTest As String) As String
Dim RegEx As Object
Dim valid As Boolean
Dim Matches As Object
Dim i As Integer
Set RegEx = CreateObject("VBScript.RegExp")
RegEx.Pattern = "\b(?:\d{1,3}\.){3}\d{1,3}\b"
valid = RegEx.test(strTest)
If valid Then
Set Matches = RegEx.Execute(strTest)
FindIP = Matches(0)
Else
FindIP = ""
End If
End Function
