通过VBA获取计算机网卡MAC地址的函数,将下列函数放到新建的模块中,然后在窗体中调用函数WMI_GetMACAddresses
'---------------------------------------------------------------------------------------
' Procedure : WMI_GetMACAddresses
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Return a listing of MAC Addresses
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Late Binding -> none required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' bConnectedOnly : Optional - Whether to include all adapters or only currently
' Enabled ones.
' True => Only include Enabled adapters
' False => Include all adapters regardless of their state
' bExcludeVMWare : Optional - Whether to include VMWare entries, or not
' True => Omit them
' False => Include them
' sDelim : Optional - Delimiter to use as a separator in the returned string
'
' Usage:
' ~~~~~~
' ? WMI_GetMACAddresses
' Returns -> 18:1D:EA:71:69:F2
'
' ? WMI_GetMACAddresses(False)
' Returns -> 00:FF:FE:96:EE:B2,18:1D:EA:71:69:F2,00:D8:61:05:A0:C7,18:1D:EA:71:69:F3
'
' ? WMI_GetMACAddresses(True, False)
' Returns -> 00:50:56:C0:00:01,00:50:56:C0:00:08,18:1D:EA:71:69:F2
'
' Revision History:
' Rev Date(yyyy-mm-dd) Description
' **************************************************************************************
' 1 2020-11-16 Initial Release
'---------------------------------------------------------------------------------------
Public Function WMI_GetMACAddresses(Optional bConnectedOnly As Boolean = True, _
Optional bExcludeVMWare As Boolean = True, _
Optional sDelim As String = ",") As String
On Error GoTo Error_Handler
#Const WMI_EarlyBind = True 'True => Early Binding / False => Late Binding
#If WMI_EarlyBind = True Then
Dim oWMI As Object
Dim oCols As Object
Dim oCol As Object
#Else
Dim oWMI As Object
Dim oCols As Object
Dim oCol As Object
Const wbemFlagReturnImmediately = 16 '(&H10)
Const wbemFlagForwardOnly = 32 '(&H20)
#End If
Dim sWMIQuery As String 'WMI Query
Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
sWMIQuery = "Select * FROM Win32_NetworkAdapterConfiguration"
If bConnectedOnly = True Then
sWMIQuery = sWMIQuery & " Where IPEnabled=TRUE"
End If
Set oCols = oWMI.ExecQuery(sWMIQuery, , wbemFlagReturnImmediately or wbemFlagForwardOnly)
For Each oCol In oCols
'Debug.Print oCol.Description, oCol.MACAddress, oCol.IPEnabled
If IsNull(oCol.MACAddress) = False Then
If bExcludeVMWare = True Then
If InStr(oCol.Description, "VMware") = 0 Then
WMI_GetMACAddresses = WMI_GetMACAddresses & oCol.MACAddress & sDelim
End If
Else
WMI_GetMACAddresses = WMI_GetMACAddresses & oCol.MACAddress & sDelim
End If
End If
Next
If Right(WMI_GetMACAddresses, Len(sDelim)) = sDelim Then _
WMI_GetMACAddresses = Left(WMI_GetMACAddresses, Len(WMI_GetMACAddresses) - Len(sDelim))
Error_Handler_Exit:
On Error Resume Next
Set oCol = Nothing
Set oCols = Nothing
Set oWMI = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: WMI_GetMACAddresses" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit
End Function