【转载】VBA获取计算机网卡MAC地址的函数

时　间:2023-03-21 09:49:26
作　者:金宇   ID：43  城市：江阴
摘　要:VBA获取计算机网卡MAC地址的函数
正　文:

通过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