【转载】VBA获取计算机网卡MAC地址的函数-金宇
Access软件网QQ交流学习群(群号码198465573),欢迎您的加入!
首页 >技术文章> Access数据库-模块/函数/VBA


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

发表时间:2023/3/21 9:49:26 评论(0) 浏览(1714)  评论 | 加入收藏 | 复制
   
摘 要: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



Access软件网交流QQ群(群号:198465573)
 
 相关文章
VBA获取网卡的物理地址  【江羽  2008/11/17】
access 2010 试用(2):数据宏 (Data Macro...  【andymark  2010/2/7】
获取本机网卡MAC码  【不祥  2010/7/20】
【access源码】一个用于获取网卡MAC地址或IP地址的通用函数...  【红尘如烟  2010/8/8】
【源码示例】轻松获取电脑网卡地址和IP信息  【杏林求真  2012/12/13】
取得电脑CPU的名称及速度,网卡序列号  【林岚  2018/1/29】
常见问答
技术分类
相关资源
文章搜索
关于作者

金宇

文章分类

文章存档

友情链接