トランザクションデータの発生や、データベースの更新などでは、更新情報として更新したコンピュータ名やユーザーをレコード上の項目に登録することがよくあります。
なぜ、「API」なのか！？
マクロ上で「ある目的」を実現するのに「API」なら実現できて、「API」を利用しないと実現できない要件であれば利用するものと思っています。ですから、「APIありき」ではありません。
このページでも上2つのボタンは以前は「API」でしたが、右のボタンで同じ機能が「API」なしで利用できます。両方のボタンで比べてみて下さい。
いずれは「Microsoft Office」の64ビットが主流になるのかも知れませんから「Declare」の記述の対応が必要になってしまうのでしょう。 「API」なしで利用できるものは「API」を使わない方法で用いる方が賢明だと思います。
このページでも上2つのボタンは以前は「API」でしたが、右のボタンで同じ機能が「API」なしで利用できます。両方のボタンで比べてみて下さい。
いずれは「Microsoft Office」の64ビットが主流になるのかも知れませんから「Declare」の記述の対応が必要になってしまうのでしょう。 「API」なしで利用できるものは「API」を使わない方法で用いる方が賢明だと思います。
64ビット版Excelの対応を行ないました。
このページのサンプルはAPIを使用しております。
Office365やOffice2019では、64ビット版になるという情報があったため、 当サイトでも順次この対応を行ない、動作確認ができたものからページを更新しています。
Office365やOffice2019では、64ビット版になるという情報があったため、 当サイトでも順次この対応を行ない、動作確認ができたものからページを更新しています。
立ち上げると動作用の6つのボタンがあります。それぞれ該当する関数から情報を取得してメッセジボックスに表示します。
(「非API」と記載があるボタンはAPIではありませんが、同様のシステム情報の取得です)
(画像をクリックすると、このサンプルがダウンロードできます)
実際の動作はダウンロードさせてご確認下さい。ソースコードの下に若干の解説があります。
ソースコードです。6つのボタンの分を一気にいきます。
10個のプロシージャがあり、上の4つはシート上のボタンから呼び出されるプロシージャです。
今回、ボタンはフォームのボタンなので標準モジュールのプロシージャが呼び出されます。上から順に「Button1_Click」「Button1R_Click」「Button2_Click」「Button2R_Click」「Button3_Click」「Button4_Click」となっており、上の画像の並び順と同じです。
「Button1R_Click」「Button2R_Click」以外のボタンのプロシージャの中身はメッセージボックスに関数の結果を表示させる1行だけの記述になっており、その関数が下の4つのプロシージャになっています。
'***************************************************************************************************
' コンピュータ名の取得、その他
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
' [参照設定]
' ・Windows Script Host Object Model
'***************************************************************************************************
' 変更日付 Rev 変更履歴内容---------------------------------------------------------------------->
' 04/11/22(1.0.0)新規作成
' 17/10/27(1.1.0)コード整理、記述標準化適用
' 19/07/27(1.2.0)コンピュータ名取得、ログイン名取得の非API版追加
' 19/10/20(2.0.0)64ビットWindows対応
'***************************************************************************************************
Option Explicit
'===================================================================================================
#If VBA7 Then
' ■コンピュータ名取得API
Private Declare PtrSafe Function GetComputerName Lib "KERNEL32.dll" Alias "GetComputerNameA" _
(ByVal lpBuffer As String, nSize As Long) As Long
' ■Windowsログイン名取得API
Private Declare PtrSafe Function GetUserName Lib "ADVAPI32.dll" Alias "GetUserNameA" _
(ByVal lpBuffer As String, nSize As Long) As Long
#Else
' ■コンピュータ名取得API
Private Declare Function GetComputerName Lib "KERNEL32.dll" Alias "GetComputerNameA" _
(ByVal lpBuffer As String, nSize As Long) As Long
' ■Windowsログイン名取得API
Private Declare Function GetUserName Lib "ADVAPI32.dll" Alias "GetUserNameA" _
(ByVal lpBuffer As String, nSize As Long) As Long
#End If
'***************************************************************************************************
' ■■■ 各ボタン処理 ■■■
'***************************************************************************************************
'* 処理名 ：Button1_Click
'* 機能 ：コンピュータ名の取得
'---------------------------------------------------------------------------------------------------
'* 返り値 ：(なし)
'* 引数 ：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2017年10月27日
'* 作成者 ：井上 治
'* 更新日 ：2017年10月27日
'* 更新者 ：井上 治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Sub Button1_Click()
'-----------------------------------------------------------------------------------------------
' コンピュータ名の取得
MsgBox FP_GetComputerName
End Sub
'***************************************************************************************************
'* 処理名 ：Button1R_Click
'* 機能 ：コンピュータ名の取得(非API版)
'---------------------------------------------------------------------------------------------------
'* 返り値 ：(なし)
'* 引数 ：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2019年07月27日
'* 作成者 ：井上 治
'* 更新日 ：2019年07月27日
'* 更新者 ：井上 治
'* 機能説明：
'* 注意事項：要参照設定：Windows Script Host Object Model
'***************************************************************************************************
Sub Button1R_Click()
'-----------------------------------------------------------------------------------------------
Dim objWshNet As IWshRuntimeLibrary.WshNetwork ' WshNetwork
Set objWshNet = New IWshRuntimeLibrary.WshNetwork
MsgBox objWshNet.ComputerName
Set objWshNet = Nothing
End Sub
'***************************************************************************************************
'* 処理名 ：Button2_Click
'* 機能 ：Windowsログイン名の取得
'---------------------------------------------------------------------------------------------------
'* 返り値 ：(なし)
'* 引数 ：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2017年10月27日
'* 作成者 ：井上 治
'* 更新日 ：2017年10月27日
'* 更新者 ：井上 治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Sub Button2_Click()
'-----------------------------------------------------------------------------------------------
' Windowsログイン名取得
MsgBox FP_GetUserName
End Sub
'***************************************************************************************************
'* 処理名 ：Button2R_Click
'* 機能 ：Windowsログイン名の取得(非API版)
'---------------------------------------------------------------------------------------------------
'* 返り値 ：(なし)
'* 引数 ：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2019年07月27日
'* 作成者 ：井上 治
'* 更新日 ：2019年07月27日
'* 更新者 ：井上 治
'* 機能説明：
'* 注意事項：要参照設定：Windows Script Host Object Model
'***************************************************************************************************
Sub Button2R_Click()
'-----------------------------------------------------------------------------------------------
Dim objWshNet As IWshRuntimeLibrary.WshNetwork ' WshNetwork
Set objWshNet = New IWshRuntimeLibrary.WshNetwork
MsgBox objWshNet.UserName
Set objWshNet = Nothing
End Sub
'***************************************************************************************************
'* 処理名 ：Button3_Click
'* 機能 ：Excelのバージョンの取得
'---------------------------------------------------------------------------------------------------
'* 返り値 ：(なし)
'* 引数 ：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2017年10月27日
'* 作成者 ：井上 治
'* 更新日 ：2017年10月27日
'* 更新者 ：井上 治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Sub Button3_Click()
'-----------------------------------------------------------------------------------------------
' Excelのバージョンの取得
MsgBox FP_GetExcelVersion
End Sub
'***************************************************************************************************
'* 処理名 ：Button4_Click
'* 機能 ：Windowsのバージョンの取得(APIではありません)
'---------------------------------------------------------------------------------------------------
'* 返り値 ：(なし)
'* 引数 ：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2017年10月27日
'* 作成者 ：井上 治
'* 更新日 ：2017年10月27日
'* 更新者 ：井上 治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Sub Button4_Click()
'-----------------------------------------------------------------------------------------------
' Windowsのバージョンの取得
'MsgBox Application.OperatingSystem
MsgBox FP_GetWindowsVersion
End Sub
'***************************************************************************************************
' ■■■ サブ処理 ■■■
'***************************************************************************************************
'* 処理名 ：FP_GetComputerName
'* 機能 ：コンピュータ名の取得
'---------------------------------------------------------------------------------------------------
'* 返り値 ：コンピュータ名(String)
'* 引数 ：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2017年10月27日
'* 作成者 ：井上 治
'* 更新日 ：2017年10月27日
'* 更新者 ：井上 治
'* 機能説明：
'* 注意事項：コンピュータ名取得API宣言必須
'***************************************************************************************************
Private Function FP_GetComputerName() As String
'-----------------------------------------------------------------------------------------------
Dim strBuffer As String ' 文字列処理バッファ
Dim lngLngs As Long ' 文字列長
' Bufferを確保
strBuffer = String(256, Chr(0))
lngLngs = Len(strBuffer)
' コンピュータ名の取得(API呼び出し) ※動作失敗は無視しています
Call GetComputerName(strBuffer, lngLngs)
' Null文字の手前までを有効として返す
FP_GetComputerName = Left(strBuffer, InStr(1, strBuffer, Chr(0)) - 1)
End Function
'***************************************************************************************************
'* 処理名 ：FP_GetUserName
'* 機能 ：Windowsログイン名取得
'---------------------------------------------------------------------------------------------------
'* 返り値 ：Windowsログイン名(String)
'* 引数 ：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2017年10月27日
'* 作成者 ：井上 治
'* 更新日 ：2017年10月27日
'* 更新者 ：井上 治
'* 機能説明：
'* 注意事項：Windowsログイン名取得API宣言必須
'***************************************************************************************************
Private Function FP_GetUserName() As String
'-----------------------------------------------------------------------------------------------
Dim strBuffer As String ' 文字列処理バッファ
Dim lngLngs As Long ' 文字列長
' Bufferを確保
strBuffer = String(256, Chr(0))
lngLngs = Len(strBuffer)
' Windowsログイン名取得(API呼び出し) ※動作失敗は無視しています
Call GetUserName(strBuffer, lngLngs)
' Null文字の手前までを有効として返す
FP_GetUserName = Left(strBuffer, InStr(1, strBuffer, Chr(0)) - 1)
End Function
'***************************************************************************************************
'* 処理名 ：FP_GetExcelVersion
'* 機能 ：Excelのバージョンの取得(APIではありません)
'---------------------------------------------------------------------------------------------------
'* 返り値 ：Excelのバージョン(String)
'* 引数 ：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2017年10月27日
'* 作成者 ：井上 治
'* 更新日 ：2019年07月27日
'* 更新者 ：井上 治
'* 機能説明：
'* 注意事項：Excel(MS-Office)の新バージョンリリース時に追加編集が必要です。
'***************************************************************************************************
Private Function FP_GetExcelVersion() As String
'-----------------------------------------------------------------------------------------------
Dim strVer As String ' バージョン値
Dim strVerName As String ' バージョン名(編集)
' Excelのバージョン取得
strVer = Application.Version
' バージョン表記の編集
Select Case Val(strVer)
Case 7: strVerName = "Excel95"
Case 8: strVerName = "Excel97"
Case 9: strVerName = "Excel2000"
Case 10: strVerName = "Excel2002(XP)"
Case 11: strVerName = "Excel2003"
Case 12: strVerName = "Excel2007"
Case 14: strVerName = "Excel2010"
Case 15: strVerName = "Excel2013"
Case 16: strVerName = "Excel2016"
Case 17: strVerName = "Excel2019"
Case Else: strVerName = "Excel" & strVer
End Select
FP_GetExcelVersion = strVerName & " (Build:" & Application.Build & ")"
End Function
'***************************************************************************************************
'* 処理名 ：FP_GetWindowsVersion
'* 機能 ：Windowsのバージョンの取得(APIではありません⇒WMI)
'---------------------------------------------------------------------------------------------------
'* 返り値 ：Windowsのバージョン(String)
'* 引数 ：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2017年10月27日
'* 作成者 ：井上 治
'* 更新日 ：2017年10月27日
'* 更新者 ：井上 治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Function FP_GetWindowsVersion() As String
'-----------------------------------------------------------------------------------------------
Dim objLocator As Object ' SWbemLocator
Dim objService As Object ' ConnectServer
Dim objOsSet As Object ' OsSet
Dim objOs As Object ' OS情報
Dim strMsg As String ' メッセージ
Set objLocator = CreateObject("WbemScripting.SWbemLocator")
Set objService = objLocator.ConnectServer
Set objOsSet = objService.ExecQuery("Select * From Win32_OperatingSystem")
strMsg = ""
' 念のため件数分巡回(1件で抜けるようですが)
For Each objOs In objOsSet
' 2巡以降の場合は改行を接続
If strMsg <> "" Then strMsg = strMsg & vbCrLf
' OS名称とバージョンを改行で接続
strMsg = strMsg & objOs.Caption & vbCrLf
strMsg = strMsg & objOs.Version
Next objOs
FP_GetWindowsVersion = strMsg
Set objOsSet = Nothing
Set objService = Nothing
Set objLocator = Nothing
End Function
'------------------------------------------<< End of Source >>--------------------------------------
「FP_GetExcelVersion」はExcelが元々持っている関数「Version」の値を表示用に編集しているもので、Excel2019までは編集させていますが、それ以降のバージョンが出現した場合はバージョン値のまま表示されます。
「FP_GetWindowsVersion」はWindowsのバージョンをWMIから取得して返すものです。 Excelには関数「OperatingSystem」があるのですが、Windows10だと「Windows (32-bit) NT :.00」となってしまい、何だか判りません。 「(32-bit)」と表示されていますが実際のWindowsはWindows10の64ビット版です。
WMIの関数利用であれば「Microsoft Windows 10 Pro 10.0.xxxxx」などと表示されます。