Access Labo #25 ファイルの操作方法を比較する

VBAのコーディングに限らず、何かをやろうとしたとき、その方法がいくつもあると、いったいどれが一番良い方法か迷うこともしばしばです。方法によって優劣があったとしても、自分なりのスタイルを決めて、常にそれを基準にコーディングするようにすれば、それはそれでよいと思いますが、新しい関数やメソッドなどが出てくると、やはり一度は違いをチェックしてみたくなります。

今回のテストも、Access2000から利用可能となった「FileSystemObject」の登場がその発端です。ファイルのサイズや作成日時を調べたり、ファイルをコピーや削除したりする手段として、Quick BasicなどのDOSの頃からあった(？)関数やステートメント、Windowsから始まったAPIに、さらにこのFileSystemObjectのプロパティやメソッドが仲間入りしたのです。APIを使うために、わざわざDeclareステートメントを使って関数の宣言を行うのも面倒ですし、FileSystemObjectの使い方を新たに覚えるのも面倒かもしれません。そもそも、VBA固有の関数が用意されているのですから、それを使えばいちばん簡単なのかもしれません。でも、パフォーマンスとしての違いはどうなのか、やはり気になるところで、一度その確認をしてみたいと思います。

まず、テスト内容として、どのようなファイル操作を行うか、その手順を説明します。実際のテストでは、これらの操作を１つのプロシージャとして連続して実行します。

Option Compare Database
Option Explicit

'テスト回数の定数
Const cintLoopMax As Integer = 100

'テストに使うファイルのパス
Const cstrFilePath1 As String = "c:\My Documents\Test1.MDB"
Const cstrFilePath2 As String = "c:\My Documents\Test2.MDB"
Const cstrFilePath3 As String = "c:\My Documents\Test3.MDB"
Const cstrFileName3 As String = "Test3.MDB"

'WindowsAPIで使う構造体、関数などの宣言
Public Type SECURITY_ATTRIBUTES
  nLength As Long
  lpSecurityDescriptor As Long
  bInheritHandle As Long
End Type
Public Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type
Public Type SYSTEMTIME
  wYear As Integer
  wMonth As Integer
  wDayOfWeek As Integer
  wDay As Integer
  wHour As Integer
  wMinute As Integer
  wSecond As Integer
  wMilliseconds As Integer
End Type
Public Const GENERIC_READ = &H80000000
Public Const OPEN_EXISTING = 3
Public Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
  (ByVal lpFileName As String, _
  ByVal dwDesiredAccess As Long, _
  ByVal dwShareMode As Long, _
  lpSecurityAttributes As SECURITY_ATTRIBUTES, _
  ByVal dwCreationDisposition As Long, _
  ByVal dwFlagsAndAttributes As Long, _
  ByVal hTemplateFile As Long) As Long
Public Declare Function GetFileTime Lib "kernel32" _
  (ByVal hFile As Long, _
  lpCreationTime As FILETIME, _
  lpLastAccessTime As FILETIME, _
  lpLastWriteTime As FILETIME) As Long
Public Declare Function FileTimeToLocalFileTime Lib "kernel32" _
  (lpFileTime As FILETIME, _
  lpLocalFileTime As FILETIME) As Long
Public Declare Function FileTimeToSystemTime Lib "kernel32" _
  (lpFileTime As FILETIME, _
  lpSystemTime As SYSTEMTIME) As Long
Public Declare Function CloseHandle Lib "kernel32" _
  (ByVal hObject As Long) As Long
Public Declare Function GetFileSize Lib "kernel32" _
  (ByVal hFile As Long, _
  lpFileSizeHigh As Long) As Long
Public Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" _
  (ByVal lpExistingFileName As String, _
  ByVal lpNewFileName As String, _
  ByVal bFailIfExists As Long) As Long
Public Declare Function MoveFile Lib "kernel32" Alias "MoveFileA" _
  (ByVal lpExistingFileName As String, _
  ByVal lpNewFileName As String) As Long
Public Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" _
  (ByVal lpFileName As String) As Long

Sub TestVBA()
'VBA関数およびステートメントによるテストプロシージャ

  Dim dtmFileDate As Date
  Dim lngFileSize As Long
  Dim iintLoop As Integer

  ts_Watch "テスト開始", True

  For iintLoop = 1 To cintLoopMax
    '更新日時を変数にセット
    dtmFileDate = FileDateTime(cstrFilePath1)
    'ファイルサイズを変数にセット
    lngFileSize = FileLen(cstrFilePath1)
  Next iintLoop
  ts_Watch "VBA関数－ファイル情報取得"

  For iintLoop = 1 To cintLoopMax
    'ファイルのコピー
    FileCopy cstrFilePath1, cstrFilePath2
    'ファイルのリネーム
    Name cstrFilePath2 As cstrFilePath3
    'ファイルの削除
    Kill cstrFilePath3
  Next iintLoop
  ts_Watch "VBA関数－ファイル操作"

End Sub

Sub TestAPI()
'Windows API関数によるテストプロシージャ

  Dim dtmFileDate As Date
  Dim lngFileSize As Long
  Dim tSecurityAttributes As SECURITY_ATTRIBUTES
  Dim lngOpenFHwnd As Long
  Dim lngRet As Long
  Dim tCreateTime As FILETIME
  Dim tLastAccessTime As FILETIME
  Dim tLastWriteTime As FILETIME
  Dim tLocalCreateTime As FILETIME
  Dim tLocalCreateSysTime As SYSTEMTIME
  Dim lngFileSizeHigh As Long
  Dim iintLoop As Integer

  ts_Watch "テスト開始", True

  For iintLoop = 1 To cintLoopMax
    'セキュリティ構造体を初期化
    tSecurityAttributes.nLength = Len(tSecurityAttributes)
    'ファイルをオープン
    lngOpenFHwnd = CreateFile(cstrFilePath1, _
                              GENERIC_READ, 0, _
                              tSecurityAttributes, _
                              OPEN_EXISTING, 0, 0)
    'ファイルハンドルが有効なとき
    If lngOpenFHwnd <> -1 Then
      '更新日時の取得
      lngRet = GetFileTime(lngOpenFHwnd, tCreateTime, tLastAccessTime, tLastWriteTime)
      '更新日時をローカルファイル日付へ変換
      lngRet = FileTimeToLocalFileTime(tLastWriteTime, tLocalCreateTime)
      '更新日時をシステムファイル日付へ変換
      lngRet = FileTimeToSystemTime(tLocalCreateTime, tLocalCreateSysTime)
      '更新日時を変数にセット
      With tLocalCreateSysTime
        dtmFileDate = DateSerial(.wYear, .wMonth, .wDay) + _
                        TimeSerial(.wHour, .wMinute, .wSecond)
      End With
      'ファイルサイズを変数にセット
      lngFileSize = GetFileSize(lngOpenFHwnd, lngFileSizeHigh)
      'ファイルをクローズ
      lngRet = CloseHandle(lngOpenFHwnd)
    End If
  Next iintLoop
  ts_Watch "WinAPI－ファイル情報取得"

  For iintLoop = 1 To cintLoopMax
    'ファイルのコピー
    lngRet = CopyFile(cstrFilePath1, cstrFilePath2, True)
    'ファイルのリネーム
    lngRet = MoveFile(cstrFilePath2, cstrFilePath3)
    'ファイルの削除
    lngRet = DeleteFile(cstrFilePath3)
  Next iintLoop
  ts_Watch "WinAPI－ファイル操作"

End Sub

Sub TestFSO()
'FileSystemObjectオブジェクトによるテストプロシージャ

  Dim dtmFileDate As Date
  Dim lngFileSize As Long
  Dim Fso As Object
  Dim Fl As Object
  Dim iintLoop As Integer

  ts_Watch "テスト開始", True

  For iintLoop = 1 To cintLoopMax
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set Fl = Fso.GetFile(cstrFilePath1)
    With Fl
      '更新日時を変数にセット
      dtmFileDate = .DateLastModified
      'ファイルサイズを変数にセット
      lngFileSize = .Size
    End With
  Next iintLoop
  ts_Watch "FileSystemObject－ファイル情報取得"

  For iintLoop = 1 To cintLoopMax
    Set Fso = CreateObject("Scripting.FileSystemObject")
    'ファイルのコピー
    Set Fl = Fso.GetFile(cstrFilePath1)
    Fl.Copy cstrFilePath2
    'ファイルのリネーム
    Set Fl = Fso.GetFile(cstrFilePath2)
    Fl.Name = cstrFileName3
    'ファイルの削除
    Set Fl = Fso.GetFile(cstrFilePath3)
    Fl.Delete
  Next iintLoop
  ts_Watch "FileSystemObject－ファイル操作"

End Sub