【Access】エラーログを出力する

システムでエラーが発生したときにファイルにエラーログを出力する方法です。

参照設定

まず、今回ファイルの作成やフォルダの作成にFileSystemObjectオブジェクトを使ので参照設定で「Microsoft Scripting Runtime」を選択してください。

標準モジュール

次に標準モジュールに下記のように記述します。

'Win32API
Private Declare Sub GetLocalTime Lib "kernel32" (lpSystem As SYSTEMTIME)

'構造体
Private 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 Sub MakeErrorLog(ByRef errObj As ErrObject, _
                        ByVal procName As String)

    Dim errNumber        As Long
    Dim errDescription   As String
    Dim messageLog       As String
    
    'エラー情報を保管
    errNumber = errObj.Number
    errDescription = errObj.Description
    
    'エラーを消去
    errObj.Clear
    
    messageLog = "【エラー番号】" & errNumber & _
              " 【詳細】" & errDescription & _
              " 【発生場所】" & procName
    
    '書き込み
    Call WriteLog(messageLog)
    
    'メッセージボックス表示
    MsgBox errNumber & Space(2) & errDescription, vbCritical, "エラー"

End Sub

'ログ出力
Private Sub WriteLog(ByVal message As String)
On Error GoTo ErrorTrap

    Dim ts, fso         As FileSystemObject
    Dim projectPath     As String
    Dim logFolder       As String
    Dim logFile         As String
    Dim logFileName     As String
    Dim sysLocalTime    As SYSTEMTIME
    
    
    '現在時刻を取得
    GetLocalTime sysLocalTime
    
    'ログファイル名
    logFileName = "error.log"
    
    'プロジェクトパスを取得
    projectPath = CurrentProject.Path
    
    'ログ格納フォルダ
    logFolder = projectPath & "\Log"
    
    'FileSystemObjectオブジェクトを作成する
    Set fso = CreateObject("Scripting.FileSystemObject")
   
    'ログ格納フォルダの確認（なければ作成）
    If fso.FolderExists(logFolder) = False Then
        Call fso.CreateFolder(logFolder)
    End If
    
    'ログファイルフルパス名
    logFile = logFolder & "\" & logFileName
    
    '追記モードでファイルオープン
    Set ts = fso.OpenTextFile(logFile, ForAppending, True)

    '書き込み
    Call ts.WriteLine("[" & sysLocalTime.wYear & "/" & _
                        Format(sysLocalTime.wMonth, "00") & "/" & _
                        Format(sysLocalTime.wDay, "00") & " " & _
                        Format(sysLocalTime.wHour, "00") & ":" & _
                        Format(sysLocalTime.wMinute, "00") & ":" & _
                        Format(sysLocalTime.wSecond, "00") & "." & _
                        Format(sysLocalTime.wMilliseconds, "000") & "] " & message)
                      
    'ファイルクローズ
    ts.Close
    
    Set ts = Nothing
    Set fso = Nothing
    
Exit Sub
ErrorTrap:
    MsgBox Err.Number & Space(2) & Err.Description, vbCritical, "エラー"
End Sub

今回、MakeErrorLogの引数にErrオブジェクトを渡してエラー番号とエラーの詳細をログに出力するようにしています。また、プロシージャ名を渡してどこでエラーが発生したかもログに残すようにしています。

実際のファイルに出力する部分は、FileSystemObjectオブジェクトを使って行っています。ファイルは追記モードで開き、発生時刻はWin32APIを使いミリ秒まで出すようにしました。

Read More

【Access】マウスポインターの形状を変更する

通常、Accessでマウスカーソルを砂時計に変更するにはDoCmd.Hourglassを使いますが、ScreenオブジェクトのMousePointerプロパティを使っても変更することが出来ます。

MousePointer プロパティの設定値

設定値	内容
0	既定値
1	標準の選択 (矢印)
3	テキスト選択 (I字型ポインター)
7	上下に拡大/縮小
9	左右に拡大/縮小
11	待ち状態 (砂時計)

1 矢印

Application.Screen.MousePointer = 1

3 I字型ポインター

Application.Screen.MousePointer = 3

7 上下に拡大/縮小

Application.Screen.MousePointer = 7

9 左右に拡大/縮小

Application.Screen.MousePointer = 9

11 待ち状態 (砂時計)

Application.Screen.MousePointer = 11

Read More

【Access】エラー発生時の終了処理

そのプロシージャを終わらせるにあたって実行しなければいけない処理というのがある場合があります。たとえば、データベースへの接続オブジェクトのクローズ処理だったり、戻り値の設定をすることだったり。ただ、エラーが発生してしまい途中でエラー処理に飛ばされてしまうことがあります。

そのような場合、エラー処理を行ったあとにResumeステートメントで終了処理に飛ばしてあげます。

例

下記の例では、マウスカーソルを砂時計に変更し、エラー発生時でも必ずマウスカーソルを元に戻すようにしています。

Public Sub ExitTest()
On Error GoTo Err_Trap

    'マウスを砂時計に切り替える
    DoCmd.Hourglass True
    
    Dim a As Long
    
    a = 30 / 0

    MsgBox "a = " & a

Exit_Trap:
    
    '終了処理

    'マウスを元に戻す
    DoCmd.Hourglass False

Exit Sub
Err_Trap:
    MsgBox "エラー番号：" & Err.Number & vbCrLf & vbCrLf & Err.Description, vbExclamation, "エラー"
    Resume Exit_Trap
End Sub

ポイントは、Err_Trapラベル後のメッセージボックスを表示したあとにResumeステートメントでExit_Trapラベルに処理を飛ばしているところです。
Resumeステートメントでラベルを指定すると、そのラベルに処理を移動できるようになっています。

Read More

【PowerShell】ファイルの拡張子を一括で変更するスクリプト

ファイルの拡張子を一括で変更するスクリプトを作ってみました。

「Change-FileExtension.ps1」

#引数（該当フォルダ, 変更前拡張子, 変更後拡張子）
param($targetDir, $oldExt, $newExt)

#正規表現の指定
$matStr = '.' + $oldExt
$oldStr = '\.'+ $oldExt + '$'
$newStr = '.' + $newExt

#該当するファイルの拡張子を置換
Get-ChildItem -Path $targetDir | Where-Object {$_.Extension -eq $matStr} | Rename-Item -NewName { $_.Name -replace $oldStr, $newStr }

実行例

たとえばフォルダ（C:\work\test）にこのようなファイルがあるとします。



このファイルの拡張子を「log」から「txt」に一括で変更するには次のよう引数を指定します。
引数は左から「該当フォルダ」「変更前拡張子」「変更後拡張子」。

PS C:\work\access> .\Change-FileExtension.ps1 C:\work\test log txt

実行するとこのように拡張子が一括で変更されます。

Read More

【Access】エラー処理

システム開発をする上で重要になってくるのがエラー処理です。エラー処理を正しく行っていないとエラーによりAccess自体を強制終了しなければいけないといったことになってしまうことがあります。

Access VBAのエラー処理は２つの方法があり、一つはエラーが起きても無視して処理を続行させる方法と、もう一つはエラーが起きたら特定の行に処理を移す方法があります。

エラーが起きても無視して処理を続行させる方法

まずは何もエラー処理してない場合です。下記のコードは０除算エラーが発生します。

Public Sub ErrorResumeTest()

    Dim a As Long
    
    a = 30 / 0
    
    MsgBox "a = " & a

End Sub

実行するとこのように「0で除算しました。」というエラーが出てプログラムが停止してしまいます。



次はこのコードに下記のように「On Error Resume Next」ステートメントを追加してみます。

Public Sub ErrorResumeTest()
On Error Resume Next

    Dim a As Long
    
    a = 30 / 0
    
    MsgBox "a = " & a

End Sub

実行結果


「On Error Resume Next」を追加すると、実行時エラーを無視するようになり、次のステートメントに処理を移しプログラムの実行を継続させます。

エラーが起きたら特定の行に処理を移す方法

次にエラーが起きた場合に特定の行に処理を移す方法です。下記のコードでは、「On Error GoTo」ステートメントを使ってエラーが起きた際に処理を移動させています。

Public Sub ErrorGotoTest()
On Error GoTo Err_Trap

    Dim a As Long
    
    a = 30 / 0

    MsgBox "a = " & a

Exit Sub
Err_Trap:
    MsgBox "エラー番号：" & Err.Number & vbCrLf & vbCrLf & Err.Description, vbExclamation, "エラー"
End Sub

GoToで指定した「Err_Trap」というラベルに処理を飛ばすようにしています。これによりプログラムを停止することなくエラーメッセージを表示させたりすることが出来るようになります。

また、注意してほしいのは、「Err_Trap」ラベルの前には「Exit Sub」などの終了処理を入れてください。そうしないとエラーが発生してないときもエラーメッセージが表示されてしまいます。


実行結果

Read More

【Access】現在のシステム日時をミリ秒単位まで取得する

通常、現在のシステムの日付と時刻を取得するにはNow関数を使いますが、システム開発を行っていると、もっと細かい単位（ミリ秒単位）で時刻を取得したいといった場合があります。そういった場合は、VBAだけでは無理ですのでWin32APIのGetLocalTime関数を使います。

例

現在のシステム日時を取得してメッセージボックスに表示してみたいと思います。

'構造体定義
Private 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

'Win32API宣言
Private Declare Sub GetLocalTime Lib "kernel32" (lpSystem As SYSTEMTIME)

Public Sub GetDetailTime()

    Dim sysLocalTime    As SYSTEMTIME
    Dim result As String
    
    '// 現在のシステム日時を取得
    GetLocalTime sysLocalTime

    result = sysLocalTime.wYear & "/" & _
            Format(sysLocalTime.wMonth, "00") & "/" & _
            Format(sysLocalTime.wDay, "00") & " " & _
            Format(sysLocalTime.wHour, "00") & ":" & _
            Format(sysLocalTime.wMinute, "00") & ":" & _
            Format(sysLocalTime.wSecond, "00") & "." & _
            Format(sysLocalTime.wMilliseconds, "000")

    MsgBox "現在の詳細時刻：" & result

End Sub

まず、上記のようにSYSTEMTIME構造体定義とGetLocalTimeのWin32API宣言を行ってください。
あとは、GetLocalTimeを実行して現在のシステム日時を取得します。
取得したシステム日時は、引数に指定したSYSTEMTIME型構造体に格納されます。


実行結果

Read More

【Access】Timer関数を使って処理時間を算出する

システム開発を行っていると処理時間というものが気になることがよくあります。Timer関数を使うと処理時間を算出することが出来ます。

Timer関数は、午前０時からの経過秒数を単精度浮動小数点数型 (Single) で返します。

例

たとえば、下記のようなForループ処理の時間を算出してみます。

Public Sub TimerTest()

    Dim startVal As Single
    Dim endVal As Single
    Dim result As Single
    Dim i As Long
    
    '開始時間の取得
    startVal = Timer()
    
    For i = 1 To 1000000000
        
        i = i + 1
        
    Next
    
    '終了時間の取得
    endVal = Timer()
    
    '処理時間算出
    result = endVal - startVal
    
    MsgBox "処理時間：" & result & " 秒"

End Sub

Forループを開始する前と後でそれぞれTimer関数を使って時間を取得し、終了時間－開始時間で処理時間を算出しています。

実行結果

Read More