【转载】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
Access软件网QQ交流群 (群号:54525238) Access源码网店
常见问答:
技术分类:
源码示例
- 【源码QQ群号19834647...(12.17)
- 【Access选项卡示例】Ac...(09.09)
- 【Access源码示例】按输入...(09.02)
- 【Access日期区间段查询】...(08.29)
- 【Access日期区间段查询】...(08.27)
- Access怎样才能实现日期时...(08.21)
- 【Access定时打开查询】A...(08.19)
- Access生成固定数量的记录...(08.13)
- Access怎样才能实现日期时...(08.12)
- Access利用导航窗体控件对...(08.03)
学习心得
最新文章
- Access自定义函数命名为中文名...(09.20)
- Access表中的字段名、字段标题...(09.19)
- Access快速开发平台--更改“...(09.18)
- 【中秋及国庆优惠】Access培训...(09.15)
- Access如何将日期型的数值转换...(09.14)
- 英文输入法输入数据中存在单引号引起...(09.11)
- 【Access选项卡示例】Acce...(09.09)
- 让Access光标停留在指定的控件...(09.07)
- 关于Access查询条件里使用通配...(09.06)
- Access报表偷懒制作法--Ac...(09.05)