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	ドライブのボリューム名を取得する

HSP

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33

;***** ドライブ情報の取得 *****   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

Excel VBA

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24

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	ファイルの種類 ( 拡張子から判定 ) を返す。

HSP

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70

;***** ファイル詳細情報の取得 *****   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

Excel VBA

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40

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変数に返されます。

HSP

1 2 3 4 5 6 7 8 9 10 11 12 13 14

;***** サーバから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

Excel VBA

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21

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)