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

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

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

  • BWin32APIを使う
  • #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
    

    AMicrosoft 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
    

    BWin32APIを使う

    #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