システム情報を参照する。

①Windows Script Hostを使う
  • #1 コンピュータ・ユーザー名の取得

    • ②Microsoft Scripting Runtimeを使う
  • #1ディスクの総容量・空き容量・その他のディスク情報を取得

    • ③Win32APIを使う
  • #1 コンピュータ名の取得

  • #2 ユーザー名の取得

  • #3 ディスクの総容量・空き容量を取得

    • ①Windows Script Hostを使う

    #1 コンピュータ・ユーザー名の取得

    <使用例>

    Sub Wsh_Network()

    Dim WshNet As Object
    Set WshNet = CreateObject("WScript.Network")
    
    With WshNet
    
        Debug.Print .ComputerName   'コンピュータ名
        Debug.Print .UserDomain     'ドメイン
        Debug.Print .UserName       'ユーザー名

    End With
    
    Set WshNet = Nothing

End Sub

    ②Microsoft Scripting Runtimeを使う

    #1ディスクの総容量・空き容量・その他のディスク情報を取得

    FileSystemObject を使う

    <使用例>

    Sub ShowDriveInfo()

    Const strDrv As String = "C:\"
    Dim fso, drv As Object
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set drv = fso.GetDrive(fso.GetDriveName(strDrv))
    
    With drv
        Debug.Print "ドライブ " & UCase(drv)
        Debug.Print "ボリュームラベル：" & .VolumeName
        Debug.Print "シリアルNo：" & .SerialNumber
        Debug.Print "ルートホルダー：" & .RootFolder
        Debug.Print "ファイルシステム：" & .FileSystem
        Debug.Print "ディスクの総容量：" & Format$(.TotalSize / 1000, "#,##0") & " KB"
        Debug.Print "ディスクの空き容量：" & Format$(.FreeSpace / 1000, "#,##0") & " KB"
    End With
    
    Set fso = Nothing
    Set drv = Nothing
End Sub


※以下の表現も同じ動作ををします。
　あらかじめ参照設定でMicrosoft Scripting Runtime にチェックを入れる必要があります。

    [参照チェック無し]
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
			↓
    [参照チェック有り]
    Dim fso As New Scripting.FileSystemObject

    ③Win32APIを使う

    #1 コンピュータ名の取得
    #2 ユーザー名の取得
    #3 ディスクの総容量・空き容量を取得
    #1 コンピュータ名の取得

    GetComputerName を使う

    <使用例>

    Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" _
    (ByVal lpBuffer As String, nSize As Long) As Long


Sub Get_ComputerName()
    Dim strBuffer As String, lngSize As Long
    
    strBuffer = String(255, vbNullChar)     ' 文字列全体に Null 文字を設定します。
    lngSize = GetComputerName(strBuffer, 255)

    Debug.Print Left(strBuffer, InStr(1, strBuffer, vbNullChar) - 1)
End Sub

    #2 ユーザー名の取得

    GetUserName を使う

    <使用例>

    Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _
    (ByVal lpBuffer As String, nSize As Long) As Long


Sub Get_UserName()
    Dim strBuffer As String, lngSize As Long
    
    strBuffer = String(255, vbNullChar)     ' 文字列全体に Null 文字を設定します。
    lngSize = GetUserName(strBuffer, 255)

    Debug.Print Left(strBuffer, InStr(1, strBuffer, vbNullChar) - 1)
End Sub

    #3 ディスクの総容量・空き容量を取得

    SHGetDiskFreeSpace を使う

    数値のデータ型を15桁使える通貨型Currencyを用います。また、Long型を使うとオーバーフローします。

    <使用例>

    Declare Function SHGetDiskFreeSpace Lib "shell32" Alias "SHGetDiskFreeSpaceA" _
    (ByVal pszVolume As String, pqwFreeCaller As Currency, pqwTot As Currency, _
    pqwFree As Currency) As Long
                                 
                                 
Sub SHGet_DiskFreeSpace()

    Dim Ret As Long
    Dim strVolume  As String, curFreeCaller, curTot, curFree As Currency
    
    strVolume = "C:\"
    Ret = SHGetDiskFreeSpace(strVolume, curFreeCaller, curTot, curFree)

    If Ret <> 0 Then
        Debug.Print "ディスクの総容量：" & Format$(curTot * 10, "#,##0") & " KB"
        Debug.Print "ディスクの空き容量：" & Format$(curFree * 10, "#,##0") & " KB"
    Else
        Exit Sub
    End If
End Sub

    関連関数：  GetDiskFreeSpace(2GB以下)  GetDiskFreeSpaceEX