4. 顯示器的螢幕解析度
'32-bit API declaration
Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public Const SM_CXSCREEN = 0
Public Const SM_CYSCREEN = 1
Sub ScreenResolution()
VidWidth = GetSystemMetrics(SM_CXSCREEN)
VidHeight = GetSystemMetrics(SM_CYSCREEN)
MsgBox "噫~ 目前螢幕解析度是: " & VidWidth & " X " & VidHeight
End Sub
以下來自 John Walkenbach
For Excel tips, macros, & downloads... http://j-walk.com/ss
1. 取得電腦名稱
Private Declare Function w32_GetComputerName Lib "kernel32" _
Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Function GetComputerName()
Dim sComputerName As String
Dim lComputerNameLen As Long
Dim lResult As Long
lComputerNameLen = 256
sComputerName = Space(lComputerNameLen)
lResult = w32_GetComputerName(sComputerName, lComputerNameLen)
If lResult <> 0 Then
GetComputerName = Left(sComputerName, lComputerNameLen)
Else
GetComputerName = "Unknown"
End If
End Function
2. 取得電腦目前登入使用者名稱
Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _
(ByVal lpBuffer As String, nSize As Long) As Long
Function UserName() As String
Dim Buffer As String * 100
Dim BuffLen As Long
BuffLen = 100
GetUserName Buffer, BuffLen
UserName = Left(Buffer, BuffLen - 1)
End Function
--------------------------------------------------------------------------------
補充：
其實有些系統/使用者資訊可以由環境變數取得。
參考 用 Environ 取得環境變數~ 不是非要API 啦
向板主檢舉 203.79.168.37 (?)
--------------------------------------------------------------------------------
BEFORE ASKING, YOU SHOULD RTFH, RTFM, STFW...
Sub Get_IP()
Dim objWMI As Object
Dim colIP As Object
strComputer = "."
Set objWMI = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colIP = objWMI.ExecQuery _
("Select * from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE")
For Each IP In colIP
If Not IsNull(IP.IPAddress) Then
For i = LBound(IP.IPAddress) To UBound(IP.IPAddress)
MsgBox IP.IPAddress(i), vbInformation, IP.Description(i)
Next
End If
Next
End Sub
取得本機網卡 MAC Address (實體位址) --
Sub Get_Mac_Addr()
Dim objWMI As Object
Dim colItems As Object
strComputer = "."
Set objWMI = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMI.ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration", _
"WQL", wbemFlagReturnImmediately + wbemFlagForwardOnly)
For Each objItem In colItems
MsgBox "MAC Address: " & objItem.MACAddress
Next
End Sub
向板主檢舉 203.79.168.37 (?)
--------------------------------------------------------------------------------
BEFORE ASKING, YOU SHOULD RTFH, RTFM, STFW...
程式碼:
Select Case ThisWorkbook.FileFormat
Case XlFileFormat.xlExcel5
MsgBox "這個活頁簿是: Excel95活頁簿"
Case XlFileFormat.xlExcel7
MsgBox "這個活頁簿是: Excel97活頁簿"
Case XlFileFormat.xlWorkbookNormal
MsgBox "這個活頁簿是: Excel2000活頁簿"
Case Else
MsgBox "這個活頁簿是: Excel95/97/2000以外活頁簿"
End Select
向板主檢舉 203.79.168.37 (?)
--------------------------------------------------------------------------------
BEFORE ASKING, YOU SHOULD RTFH, RTFM, STFW...
leonchou
論壇維護群
離線
文章: 1214
取得VBA版本/作業系統版本 by WMI
« 回覆文章 #7 於: 2008-11-22, 20:29:29 »
--------------------------------------------------------------------------------
取得VBA版本 by WMI
參考網址 - Microsoft技術文件
程式碼:
Dim WMIServ As Object, objList As Object
basePath = Environ("ProgramFiles") & "\Common Files\Microsoft Shared\VBA"
filePath = Array(basePath, basePath & "\VBA6")
Filename = Array("vbe.dll", "vbe6.dll")
Set WMIServ = GetObject("winmgmts:\\.\root\cimv2")
For i = LBound(filePath) To UBound(filePath)
Set objList = WMIServ.ExecQuery _
("ASSOCIATORS OF {Win32_Directory.Name='" & filePath(i) & _
"'} Where " & "ResultClass = CIM_DataFile")
On Error Resume Next
For Each f In objList
'If f.Extension = "dll" Then
If Mid(f.Name, InStrRev(f.Name, "\") + 1) = Filename(i) Then
MsgBox "您的VBA版本是: " & f.Version
Exit For
End If
Next
Next
Set objList = Nothing: Set WMIServ = Nothing
取得完整的作業系統版本名稱 by WMI
輸出範例: Windows 2000 Professional (5.0.2195)
程式碼:
Dim Locator, Service, objList, msg As String
Set Locator = CreateObject("WbemScripting.SWbemLocator")
Set Service = Locator.ConnectServer
Set objList = Service.ExecQuery("Select * From Win32_OperatingSystem")
For Each os In objList
msg = msg & os.Caption & vbCrLf
msg = msg & os.Version
Next os
MsgBox "您的OS版本是: " & msg, vbInformation
Set Service = Nothing
Set objList = Nothing
Set Locator = Nothing
--------------------------------------------------------------------------------
BEFORE ASKING, YOU SHOULD RTFH, RTFM, STFW...作者: brabus 時間: 2013-10-9 20:58
