HSPとExcel VBAで情報取得 (その4)

1.概要

HSP3やExcel VBAによるCOMオブジェクトの活用事例としての第四弾です。 今回は、前回記事に引き続き、FileSystemObjectによるドライブ情報の取得、ファイルのサイズや属性等の詳細情報を取得して見ます。 また、ファイル関連の情報ばかりでは、つまらないので、少し変わった所として、XMLHTTPによるサーバーからGMT(グリニッジ標準時)を取得 するを取り上げて見ました。COMオブジェクトについては、まだまだ紹介しきれない部分も多々あるのですが、 今回の記事で終わりです。



2.サンプル

2-1.ドライブ情報を取得する
ドライブの情報の取得には、FileSystemObjectを使います。Driveオブジェクトはドライブを表すオブジェクトで GetDriveメソッド、Drivesプロパティ、FileオブジェクトとFolderオブジェクトのDriveプロパティから取得でき ます。Driveオブジェクトには以下の12種類のプロパティがります。 ドライブ名、ドライブの種類、ディスクの空きスペースの大きさなどが取得できます。

ドライブ情報取得プロパティ

プロパティ	機　能
AvailableSpace	利用可能な空きスペースの大きさを取得する
DriveLetter	ドライブ名（「C」など）を取得する
DriveType	ドライブの種類を取得する
FileSystem	ドライブのファイルシステムを取得する
FreeSpace	利用可能な空きスペースの大きさを取得する
AvailableSpace	ディスクの空きスペースの大きさを取得する
IsRead	ドライブが準備できているかどうかを取得する
Path	コロン付きのドライブ名を取得する
RootFolder	プロパティルートフォルダを表すFolderオブジェクトを取得する
SerialNumber	ディスクのシリアルナンバーを取得する
ShareName	ネットワーク・ドライブの共有名を取得する
TotalSize	ディスクの総容量を取得する
VolumeName	ドライブのボリューム名を取得する

	;***** ドライブ情報の取得 *****
	onexit *owari
	newcom objFS, "Scripting.FileSystemObject"

	;ドライブ情報の取得
	Drive = "D"
	objDrive=objFS("GetDrive", Drive)

	mes "AvailableSpace : " + strf("%3.0f", objDrive("AvailableSpace"))
	mes "DriveLetter : " + objDrive("DriveLetter")
	mes "DriveType : " + objDrive("DriveType")
	mes "FileSystem : " + objDrive("FileSystem")
	mes "FreeSpace : " + strf("%3.0f", objDrive("FreeSpace"))
	mes "IsReady : " + objDrive("IsReady")
	mes "Path : " + objDrive("Path")
	;mes objDrive("RootFolder")  ※取得できない
	mes "RootFolder : "
	mes "SerialNumber : " + objDrive("SerialNumber")
	mes "ShareName : " + objDrive("ShareName")
	mes "VolumeName : " + objDrive("VolumeName")
	mes " "
	mes "処理が終了しました。"
	stop

*owari
	;COMオブジェクト型で、有効なCOMオブジェクトを保持しているか
	if vartype(objFS)==6 {
		if varuse(objFS)==1 : delcom objFS
	}
		if vartype(objDrive)==6 {
		if varuse(objDrive)==1 : delcom objDrive
	}
	end

Sub GetDriveInfo()
    '***** ドライブ情報の取得 *****
    Dim objFS, objDrive As Object
    
    Set objFS = CreateObject("Scripting.FileSystemObject")
    Set objDrive = objFS.GetDrive("D")

    '***** 表示処理 *****
    Cells(1, 1).Value = "AvailableSpace       : " & objDrive.AvailableSpace
    Cells(2, 1).Value = "DriveLetter          : " & objDrive.DriveLetter
    Cells(3, 1).Value = "DriveType            : " & objDrive.DriveType
    Cells(4, 1).Value = "FileSystem           : " & objDrive.FileSystem
    Cells(5, 1).Value = "FreeSpace            : " & objDrive.FreeSpace
    Cells(6, 1).Value = "IsReady              : " & objDrive.IsReady
    Cells(7, 1).Value = "Path                 : " & objDrive.Path
    Cells(8, 1).Value = "RootFolder           : " & objDrive.RootFolder
    Cells(9, 1).Value = "SerialNumber         : " & objDrive.SerialNumber
    Cells(10, 1).Value = "ShareName           : " & objDrive.ShareName
    Cells(11, 1).Value = "TotalSize           : " & objDrive.TotalSize
    Cells(12, 1).Value = "VolumeName          : " & objDrive.VolumeName

    Set objFS = Nothing
    Set objDrive = Nothing
End Sub

2-2.ファイルのサイズや属性等の詳細情報を取得する
ファイルの詳細情報の取得には、FileSystemObjectを使います。HSPでは、 ファイル選択ダイアログで任意のファイルを選 択して、ファイル名を引数とするGetFileメソッドに渡し、 objFInfoオブジェクト変数に ファイル情報を代入します。そして、各プロパティを引数として詳細情報を参照します。 FileSystemObjectのファイル情報関連のプロパティは、次のようになっていますが、利用 環境によっては、 全ての情報を取得することができません。

ファイル詳細情報取得関連プロパティ

プロパティ	意　味
Attributes	ファイルの属性の設定や値の取得を行なう
DateCreated	ファイルの作成日時を返す。変更不可
DateLastAccessed	ファイルが最後にアクセスされたときの日付を返す。変更不可
DateLastModified	ファイルが最後に変更されたときの日時を返す。変更不可
Drive	ファイルが格納されているドライブ名を返す
Name	ファイル名を返す。変更可能
ParentFolder	ファイルが格納されているフォルダ名を返す。変更不可
Path	ファイルのパスを返す
ShortName	DOSの8.3形式のファイル名を返す。
ShortPath	ファイルの属性の設定や値の取得を行なう
Size	ファイルのサイズ(バイト)を返す。
Type	ファイルの種類 ( 拡張子から判定 ) を返す。

	;***** ファイル詳細情報の取得 *****
	onexit *owari
	newcom objFS, "Scripting.FileSystemObject"
	sdim sFile,260,16

	;ファイルの指定
	dialog "",16 : if stat==0 : stop

	;ファイル存在の確認  (objexFile=0 : なし,objexFile=-1 : あり)
	objexFile=objFS("FileExists", refstr)
	if objexFile==0 {
		dialog "ファイルは存在しません。 結果="+objexFile
		stop
	}
	;ファイル情報の取得
	objFInfo=objFS("GetFile", refstr)

	sFile(0)=objFInfo("Name")
	sFile(1)=objFInfo("ShortName")
	sFile(2)=objFInfo("Path")
	sFile(3)=objFInfo("ShortPath")

	;※取得できない
	;sFile(4)=objFInfo("ParentFolder.Path")
	;sFile(5)=objFInfo("Drive.Path")

	size=objFInfo("Size")
	sFile(7)=objFInfo("Type")

	att=objFInfo("Attributes")
	if (att&1)==1   : sFile(8)="読み取り専用"
	if (att&2)==2   : sFile(8)="隠しファイル"
	if (att&4)==4   : sFile(8)="システム"
	if (att&16)==16 : sFile(8)="フォルダ"
	if (att&32)==32 : sFile(8)="アーカイブ"

	;※取得できない
	;sFile(9)=objFInfo("DateCreated")
	;sFile(10)=objFInfo("DateLastAccessed")
	;sFile(11)=objFInfo("DateLastModified")

	;ファイル情報の表示
	font "Meiryo UI",14 : objmode 2
	pos 10,10
	mes "Name : "+sFile(0)
	mes "ShortName : "+sFile(1)
	mes "Path : "+sFile(2)
	mes "ShortPath : "+sFile(3)
	mes "ParentFolder.Path : "+sFile(4)
	mes "Drive.Path : "+sFile(5)
	mes "Size : "+size+" (byte)"
	mes "Type : "+sFile(7)
	mes "属性 : "+sFile(8)
	mes "DateCreated : "+sFile(9)
	mes "DateLastAccessed : "+sFile(10)
	mes "DateLastModified : "+sFile(11)

	mes " "
	mes "処理が終了しました。"
	stop

*owari
	;COMオブジェクト型で、有効なCOMオブジェクトを保持しているか
	if vartype(objFS)==6 {
		if varuse(objFS)==1 : delcom objFS
	}
	if vartype(objFInfo)==6 {
		if varuse(objFInfo)==1 : delcom objFInfo
	}
	end

Sub GetFileInfo()
    '***** ファイル詳細情報の取得 *****
    Dim objFS, objFile As Object
    Dim SelFile As Variant
    Dim att As String
    
    Set objFS = CreateObject("Scripting.FileSystemObject")
    
    '***** ファイル選択 *****
    SelFile = Application.GetOpenFilename("ファイル(*.*),*.*")
    If VarType(SelFile) = vbBoolean Then
       MsgBox "キャンセルされました"
       Exit Sub
    End If
    
    Set objFile = objFS.GetFile(SelFile)

    '***** 表示処理 *****
    If objFile.Attributes = 1 Then att = "読み取り専用"
    If objFile.Attributes = 2 Then att = "隠しファイル"
    If objFile.Attributes = 4 Then att = "システム"
    If objFile.Attributes = 16 Then att = "フォルダ"
    If objFile.Attributes = 32 Then att = "アーカイブ"
    
    Cells(1, 1).Value = "Attributes       : " & att & "(" & objFile.Attributes & ")" 'ファイルの属性
    Cells(2, 1).Value = "DateCreated      : " & objFile.DateCreated                  'ファイルの作成日時
    Cells(3, 1).Value = "DateLastAccessed : " & objFile.DateLastAccessed             'ファイルが最後にアクセスされたときの日付
    Cells(4, 1).Value = "DateLastModified : " & objFile.DateLastModified             'ファイルが最後に変更されたときの日時
    Cells(5, 1).Value = "Drive            : " & objFile.Drive.Path                   'ファイルが格納されているドライブ名
    Cells(6, 1).Value = "Name             : " & objFile.Name                         'ファイル名
    Cells(7, 1).Value = "ParentFolder     : " & objFile.ParentFolder.Path            'ファイルが格納されているフォルダ名
    Cells(8, 1).Value = "Path             : " & objFile.Path                         'ファイルのパス
    Cells(9, 1).Value = "ShortName        : " & objFile.ShortName                    'DOSの8.3形式のファイル名
    Cells(10, 1).Value = "ShortPath       : " & objFile.ShortPath                    'DOSの8.3形式のフォルダ名
    Cells(11, 1).Value = "Size            : " & objFile.Size & "(byte)"              'ファイルのサイズ(バイト)
    Cells(12, 1).Value = "Type            : " & objFile.Type                         'ファイルの種類 ( 拡張子から判定 )

    Set objFile = Nothing
    Set objFS = Nothing
End Sub

2-3.サーバーからGMT(グリニッジ標準時)を取得する
https://www.yahoo.co.jpのサーバーからGMT(グリニッジ標準時)を取得します。 XMLHTTP コントロールにより、指定したURLを引数として、HTTPリクエストを送信します。 getResponseHeaderで 指定したレスポンスヘッダの内容を取得します。 statusは、HTTPレ スポンスステータスコードで、200ならOK、 404ならNot Foundとなります。 先程のgetResponseHeaderで"Date"を指定して、サーバーから GMT(グリニッジ標準時)を取得しています。結果は、sDate変数に返されます。

	;***** サーバからGMT(グリニッジ標準時)を取得  *****
	pos 10,10 : mes "ネット接続環境によっては取得に時間がかかる場合があります。"
	newcom objXMLHTTP, "Microsoft.XMLHTTP"
	sURL = "https://www.yahoo.co.jp/"
	objXMLHTTP->"Open" "HEAD", sURL, 0
	objXMLHTTP->"send"
	if objXMLHTTP("status") = 200 {
		sDate=objXMLHTTP("getResponseHeader", "Date")
		mes sDate
	}else{
		dialog "接続に失敗致しました。",0,"エラー"
	}
	delcom objXMLHTTP
	stop

Sub GetGMT()
    '***** サーバからGMT(グリニッジ標準時)を取得 *****
    Dim objXMLHTTP As Object
    Dim sURL As String

    Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")

    sURL = "https://www.yahoo.co.jp/"
    objXMLHTTP.Open "GET", sURL, False
    objXMLHTTP.send


    If objXMLHTTP.Status = 200 Then
        resData = objXMLHTTP.getResponseHeader("Date")
        MsgBox resData
    Else
        MsgBox "接続に失敗致しました。"
    End If

    Set oXMLHTTP = Nothing
End Sub

3.ソースコードについて

掲載ソースコードのライセンスは、CC0 (クレジット表示不要、改変可、商用可) とします。自由に利用して頂いてかまいません。 尚、データの取得やプログラム実行において損害等が生じた場合は、筆者は一切の責任も負いません。全て自己責任でお願いします。

■関連記事
・HSPとExcel VBAで情報取得 (COMオブジェクトの活用)
・HSPとExcel VBAで情報取得 (その1)
・HSPとExcel VBAで情報取得 (その2)
・HSPとExcel VBAで情報取得 (その3)