Aşağıdaki kodları bir Module içine yazın.

Option Explicit
Public Const NO_ERROR = 0
Public Declare Function inet_addr _
Lib "wsock32.dll" (ByVal s As String) As Long
Public Declare Function SendARP _
Lib "iphlpapi.dll" (ByVal DestIP As Long, _
ByVal SrcIP As Long, _
pMacAddr As Long, _
PhyAddrLen As Long) As Long
Public Declare Sub CopyMemory _
Lib "kernel32" _
Alias "RtlMoveMemory" (dst As Any, _
src As Any, _
ByVal bcount As Long)
Public Function GetRemoteMACAddress(ByVal sRemoteIP As String, _
sRemoteMacAddress As String) As Boolean
Dim dwRemoteIP As Long
Dim pMacAddr As Long
Dim bpMacAddr() As Byte
Dim PhyAddrLen As Long
Dim cnt As Long
Dim tmp As String
dwRemoteIP = inet_addr(sRemoteIP)
If dwRemoteIP <> 0 Then
PhyAddrLen = 6
If SendARP(dwRemoteIP, 0&, pMacAddr, PhyAddrLen) = NO_ERROR Then
If pMacAddr <> 0 And PhyAddrLen <> 0 Then
ReDim bpMacAddr(0 To PhyAddrLen - 1)
CopyMemory bpMacAddr(0), pMacAddr, ByVal PhyAddrLen
For cnt = 0 To PhyAddrLen - 1
If bpMacAddr(cnt) = 0 Then
tmp = tmp & "00-"
Else
tmp = tmp & Hex$(bpMacAddr(cnt)) & "-"
End If
Next
If Len(tmp) > 0 Then
sRemoteMacAddress = left$(tmp, Len(tmp) - 1)
GetRemoteMACAddress = True
End If
Exit Function
Else
GetRemoteMACAddress = False
End If
Else
GetRemoteMACAddress = False
End If
Else
GetRemoteMACAddress = False
End If
End Function

Şimdi bu modülümüzü kullanalım.

Dim MacAdres As String
Dim sRemoteMacAddress As String
If GetRemoteMACAddress("192.168.1.1", sRemoteMacAddress) Then
MacAdres = sRemoteMacAddress
Else
MacAdres = "0"
End If
If MacAdres <> "0" Then
MsgBox MacAdres
Else
MsgBox "Adrese Ulaşılamadı"
End If

Modülümüzü yukarıdaki gibi kullanabiliriz. 192.168.1.1 ipsini fiziksel adresini öğrenmek istediğiniz donanımın ipisi ile değiştirerek fiziksel adresi öğrenebilirsiniz.

Kolay Gelsin.