テキストデータの追記書き出し

「追記」とは、今までのファイルの内容の後ろに「書き足す」ことを言います。
当回に処理した分を累積データの最後に書き加えるようなイメージです。 記述自体はファイルのオープンモードが違うだけなので面白くないですが、初心者の方はこのような機能の有無を知っているかどうかだけでも先に役に立つかも知れません。 私は、個人的には処理のエラーログの出力などでこの方法を頻繁に使っています。
64ビット版Excelの対応を行ないました。   このページのサンプルはAPIを使用しております。
Office365やOffice2019では、64ビット版になるという情報があったため、 当サイトでも順次この対応を行ない、動作確認ができたものからページを更新しています。



さて、まずは、「古くからあるステートメント」の方法です。
「テキストデータの書き出し」とは、出力ファイルをOpenステートメントで開く時のモードを「For Output」から「For Append」に変えるだけで追記書き出しになります。

'***************************************************************************************************
'   テキストファイル追記書き出しサンプル                            Module1(Module)
'
'   作成者:井上治  URL:http://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'03/07/25(1.00)新規作成
'03/12/04(1.01)初回修正
'20/02/26(1.10)*.xlsm化、他
'***************************************************************************************************
Option Explicit
'===================================================================================================
Private Const g_cnsTitle As String = "テキストファイル追記書き出し"
Private Const g_cnsFilter As String = "テキストファイル (*.txt;*.dat),*.txt;*.dat"

'***************************************************************************************************
'   ■■■ ワークシート側からの呼び出し処理 ■■■
'***************************************************************************************************
'* 処理名 :APPEND_TextFile1
'* 機能  :テキストファイル追記書き出しサンプル
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年07月25日
'* 作成者 :井上 治
'* 更新日 :2020年02月26日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:サンプルなのでエラー処理は行なっていません
'***************************************************************************************************
Sub APPEND_TextFile1()
    '-----------------------------------------------------------------------------------------------
    Dim intFF As Integer                                            ' FreeFile値
    Dim lngRow As Long                                              ' 収容するセルの行
    Dim lngRowMax As Long                                           ' データが収容された最終行
    Dim lngRec As Long                                              ' レコード件数カウンタ
    Dim strRec As String                                            ' 書き出すレコード内容
    Dim strFileName As String                                       ' OPENするファイル名(フルパス)
    Dim vntFileName As Variant                                      ' ファイル名受取り用
    '-----------------------------------------------------------------
    ' @「名前を付けて保存」のフォームでファイル名の指定を受ける
    Application.StatusBar = "追記出力するファイル名を指定して下さい。"
    vntFileName = Application.GetSaveAsFilename(InitialFilename:="SAMPLE.txt", _
                                                FileFilter:=g_cnsFilter, _
                                                Title:=g_cnsTitle)
    ' キャンセルされた場合はFalseが返るので以降の処理は行なわない
    If VarType(vntFileName) = vbBoolean Then Exit Sub
    strFileName = vntFileName
    '-----------------------------------------------------------------
    ' A収容最終行の判定(Excel認知の最終行から上に向かってデータがある行を探す)
    If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData      ' オートフィルタ解除
    lngRowMax = Range("$A$" & Rows.Count).End(xlUp).Row
    ' データ未登録は終了
    If lngRowMax < 2 Then
        Application.StatusBar = False
        MsgBox "テキストをA列2行目から入力してから起動して下さい。", vbExclamation, g_cnsTitle
        Exit Sub
    End If
    ' FreeFile値の取得(以降この値で入出力する)
    intFF = FreeFile
    ' 指定ファイルをOPEN(追記モード)
    Open strFileName For Append As #intFF
    ' 2行目から開始
    lngRow = 2
    '-----------------------------------------------------------------
    ' B最終行まで繰り返す
    Do While lngRow <= lngRowMax
        ' レコード件数カウンタの加算
        lngRec = lngRec + 1
        Application.StatusBar = "出力中です....(" & lngRec & "レコード目)"
        ' A列内容をレコードにセット(先頭は2行目)
        strRec = Cells(lngRow, 1).Value
        ' レコードを出力
        Print #intFF, strRec
        ' 行を加算
        lngRow = lngRow + 1
    Loop
    '-----------------------------------------------------------------
    ' C指定ファイルをCLOSE
    Close #intFF
    Application.StatusBar = False
    ' 終了の表示
    MsgBox "ファイル出力が完了しました。" & vbCr & _
        "レコード件数=" & lngRec & "件", vbInformation, g_cnsTitle
End Sub

'----------------------------------------<< End of Source >>----------------------------------------
(ここをクリックすると、このページのサンプルがダウンロードできます)
但し、新しいファイル名を指定した初回は、「For Output」と全く同じように動作します。

では、FSO(FileSystemObject)での出力です。
FSO(FileSystemObject)では、「テキストデータの書き出し」と若干違いCreateTextFileメソッドではなく、「テキストデータの読み込み」で使用したOpenTextFileメソッドをIOMode:=ForAppendingで使用します。

'***************************************************************************************************
'   テキストファイル追記書き出しサンプル(FSO版)                     Module2(Module)
'
'   作成者:井上治  URL:http://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'   [参照設定]
'   ・Microsoft Scripting Runtime
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'03/07/25(1.00)新規作成
'03/12/04(1.01)初回修正
'20/02/26(1.10)*.xlsm化、他
'***************************************************************************************************
Option Explicit
'===================================================================================================
Private Const g_cnsTitle As String = "テキストファイル追記書き出し"
Private Const g_cnsFilter As String = "テキストファイル (*.txt;*.dat),*.txt;*.dat"

'***************************************************************************************************
'   ■■■ ワークシート側からの呼び出し処理 ■■■
'***************************************************************************************************
'* 処理名 :APPEND_TextFile2
'* 機能  :テキストファイル追記書き出しサンプル(FSO版)
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2003年07月25日
'* 作成者 :井上 治
'* 更新日 :2020年02月26日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:サンプルなのでエラー処理は行なっていません
'***************************************************************************************************
Sub APPEND_TextFile2()
    '-----------------------------------------------------------------------------------------------
    Dim objFso As FileSystemObject                                  ' FileSystemObject
    Dim objTs As TextStream                                         ' TextStream
    Dim lngRow As Long                                              ' 収容するセルの行
    Dim lngRowMax As Long                                           ' データが収容された最終行
    Dim lngRec As Long                                              ' レコード件数カウンタ
    Dim strRec As String                                            ' 書き出すレコード内容
    Dim strFileName As String                                       ' OPENするファイル名(フルパス)
    Dim vntFileName As Variant                                      ' ファイル名受取り用
    '-----------------------------------------------------------------
    ' @「名前を付けて保存」のフォームでファイル名の指定を受ける
    Application.StatusBar = "追記出力するファイル名を指定して下さい。"
    vntFileName = Application.GetSaveAsFilename(InitialFilename:="SAMPLE.txt", _
                                                FileFilter:=g_cnsFilter, _
                                                Title:=g_cnsTitle)
    ' キャンセルされた場合はFalseが返るので以降の処理は行なわない
    If VarType(vntFileName) = vbBoolean Then Exit Sub
    strFileName = vntFileName
    '-----------------------------------------------------------------
    ' A収容最終行の判定(Excel認知の最終行から上に向かってデータがある行を探す)
    If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData      ' オートフィルタ解除
    lngRowMax = Range("$A$" & Rows.Count).End(xlUp).Row
    ' データ未登録は終了
    If lngRowMax < 2 Then
        Application.StatusBar = False
        MsgBox "テキストをA列2行目から入力してから起動して下さい。", vbExclamation, g_cnsTitle
        Exit Sub
    End If
    Set objFso = New FileSystemObject
    ' 指定ファイルをOPEN(追記モード)
    Set objTs = objFso.OpenTextFile(Filename:=strFileName, _
                                    IOMode:=ForAppending, _
                                    Create:=True)
    Set objFso = Nothing
    ' 2行目から開始
    lngRow = 2
    '-----------------------------------------------------------------
    ' B最終行まで繰り返す
    Do While lngRow <= lngRowMax
        ' レコード件数カウンタの加算
        lngRec = lngRec + 1
        Application.StatusBar = "出力中です....(" & lngRec & "レコード目)"
        ' A列内容をレコードにセット(先頭は2行目)
        strRec = Cells(lngRow, 1).Value
        ' レコードを出力
        objTs.WriteLine strRec
        ' 行を加算
        lngRow = lngRow + 1
    Loop
    '-----------------------------------------------------------------
    ' C指定ファイルをCLOSE
    objTs.Close
    Set objTs = Nothing
    Application.StatusBar = False
    ' 終了の表示
    MsgBox "ファイル出力が完了しました。" & vbCr & _
        "レコード件数=" & lngRec & "件", vbInformation, g_cnsTitle
End Sub

'----------------------------------------<< End of Source >>----------------------------------------
ここでの「Create:=True」は、出力ファイルが存在しない時に作成するかどうかの指定で、Open, Printステートメントの方法ではこの指定はできずに無条件で作成されます。

「追記」書き出しの代表例である「タイムレコーダ」を作ってみましょう。
あくまで「サンプル」です。   ここで紹介するのは「追記」書き出しの例であって、このまま実運用ができるものではありません。
まず、出力先が共有フォルダのテキストファイルなのでデータの改ざんは可能です。プロジェクトをロックしてマクロコードを不可視にして、出力先フォルダを非表示にするなどである程度の防御はできますが、「完全」な対策ではありません。 また、クライアントPCのシステム時刻を利用しているため、故意に時刻を変更して出力させることもできてしまいます。
ということで、あくまで「サンプル」としてご覧下さい。



「タイムレコーダ」のサンプル
(画像をクリックすると、このサンプルがダウンロードできます)
仕組みは簡単です。
「出社」ボタンか「退社」ボタンをクリックして、確認メッセージで「はい」を選択すると打刻データが出力されます。 出力先のフォルダをネットワーク上の共有フォルダにすれば、正しい運用の範囲内で打刻データを収集することができるものです。



「タイムレコーダ」のサンプル
これは「出社」ボタンをクリックしたところです。出退の間違いをできるだけ回避させるために確認メッセージを表示させています。
「はい」を選択すれば打刻データが出力されます。



「タイムレコーダ」のサンプル
念のため、出力後にも確認メッセージを表示させています。



「タイムレコーダ」のサンプル
ネットワーク上のトラブルや設定の問題も考えられるので、出力不成功の場合はエラーメッセージを表示させています。



出力データはこのようなイメージです。

inoue,2020/02/26 19:26:55,1
inoue,2020/02/26 19:29:20,2
サンプルでは3項目のCSV(カンマ区切り)テキスト形式ファイルになっていて、最初がWindowsログインユーザー、次がタイムスタンプ、最後が処理モードで「出社」が「1」、「退社」が「2」となっています。



では、コードを見てみましょう。

'***************************************************************************************************
'   タイムレコーダプログラムサンプル
'
'   作成者:井上治  URL:http://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
' [参照設定]
'   ・Microsoft Scripting Runtime
'   ・Windows Script Host Object Model
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'07/05/20(1.00)新規作成
'19/10/24(1.10)*.xlsm化
'20/02/26(1.11)コード整理、「Option Private Module」追加
'***************************************************************************************************
Option Explicit
Option Private Module
'===================================================================================================
Private Const g_cnsTitle = "タイムレコーダ"
' 出力ファイル名(適時変更して下さい)
Private Const g_cnsSubFolder As String = "TIMERECORD"
Private Const g_cnsFilename As String = "TIMERECORD.dat"
Private Const g_cnsCOM As String = ","
Private Const g_cnsTimeFormat As String = "YYYY/MM/DD HH:NN:SS"
'---------------------------------------------------------------------------------------------------
' APIは条件付きコンパイルで64ビット版Windowsにも対応
#If VBA7 Then
' ■スリープ
Private Declare PtrSafe Sub Sleep Lib "KERNEL32.dll" _
    (ByVal dwMilliseconds As Long)
#Else
' ■スリープ
Private Declare Sub Sleep Lib "KERNEL32.dll" _
    (ByVal dwMilliseconds As Long)
#End If
'---------------------------------------------------------------------------------------------------
' 出力パスはマイドキュメント内に「TIMERECORD」になります
Private g_strPathname As String                                     ' 出力パス

'***************************************************************************************************
'   ■■■ 起動時処理(既定) ■■■
'***************************************************************************************************
'* 処理名 :Auto_Open
'* 機能  :起動時処理(Windowsログイン名取得)
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2007年05月20日
'* 作成者 :井上 治
'* 更新日 :2020年02月26日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub Auto_Open()
    '-----------------------------------------------------------------------------------------------
    ActiveSheet.Protect UserInterfaceOnly:=True
    ' Windowsログイン名取得
    Cells(1, 6).Value = FP_GetWinUser
    ThisWorkbook.Saved = True
End Sub

'***************************************************************************************************
'   ■■■ ワークシート側からのボタン呼び出し処理 ■■■
'***************************************************************************************************
'* 処理名 :WRITE_SYUSSYA
'* 機能  :「出社」打刻登録(Mode=1)
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2007年05月20日
'* 作成者 :井上 治
'* 更新日 :2020年02月26日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Public Sub WRITE_SYUSSYA()
    '-----------------------------------------------------------------------------------------------
    Const cnsMODE = 1
    Const cnsMODE_NAME = "「出社」"
    ' 打刻出力処理
    Call GP_WRITE_TIMESTAMP(cnsMODE, cnsMODE_NAME)
End Sub

'***************************************************************************************************
'* 処理名 :WRITE_TAISYA
'* 機能  :「退社」打刻登録(Mode=2)
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2007年05月20日
'* 作成者 :井上 治
'* 更新日 :2020年02月26日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Public Sub WRITE_TAISYA()
    '-----------------------------------------------------------------------------------------------
    Const cnsMODE = 2
    Const cnsMODE_NAME = "「退社」"
    ' 打刻出力処理
    Call GP_WRITE_TIMESTAMP(cnsMODE, cnsMODE_NAME)
End Sub

'***************************************************************************************************
'   ■■■ サブ処理(Private) ■■■
'***************************************************************************************************
'* 処理名 :GP_WRITE_TIMESTAMP
'* 機能  :打刻出力処理(WinUser,TimeStamp,Mode)
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :Arg1 = 出退モード(Integer)     ※1=出社、2=退社
'*      Arg2 = 出退モード名(String)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2007年05月20日
'* 作成者 :井上 治
'* 更新日 :2020年02月26日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub GP_WRITE_TIMESTAMP(ByVal intMode As Integer, ByVal strModeName As String)
    '-----------------------------------------------------------------------------------------------
    Dim objFso As FileSystemObject                                  ' FileSystemObject
    Dim objTs As TextStream                                         ' TextStream
    Dim cntReTry As Long                                            ' リトライカウンタ
    Dim dteNow As Date                                              ' 現在日時
    Dim strRec As String                                            ' 出力レコード
    Dim strUser As String                                           ' ユーザーID
    Dim strNow As String                                            ' 現在日時(編集)
    Dim strFullname As String                                       ' フルパスファイル名
    Dim strMSG As String                                            ' メッセージWORK
    ' 打刻モードの確認
    If MsgBox(strModeName & "を登録します。" & vbCr & "よろしいですね?", _
        vbInformation + vbYesNo, g_cnsTitle) <> vbYes Then Exit Sub
    '-----------------------------------------------------------------------------------------------
    ' Windowsログイン名取得(念のため再取得)
    strUser = FP_GetWinUser
    ' 現在時刻取得
    dteNow = Now()
    strNow = Format(dteNow, g_cnsTimeFormat)
    ' 出力レコード(カンマ区切り)を編集
    strRec = strUser & g_cnsCOM & strNow & g_cnsCOM & intMode
    ' FileSystemObjectの取得
    Set objFso = New FileSystemObject
    ' タイムレコーダ出力フォルダ名取得(ネットワーク上に出力するような場合は変更して下さい)
    Call GP_GetTimerecorderPath(objFso)
    ' フルパスファイル名を編集
    strFullname = objFso.BuildPath(g_strPathname, g_cnsFilename)
    ' 追記モードでファイルをOPEN(TextStream)
    On Error GoTo TIMESTAMP_OPEN_ERROR
    Set objTs = objFso.OpenTextFile(strFullname, ForAppending, True)
    On Error GoTo 0
    ' レコードを出力
    objTs.WriteLine strRec
    ' ファイルをCLOSE
    objTs.Close
    ' 処理完了メッセージ
    MsgBox strModeName & "を出力しました。" & vbCr & vbCr & _
        "ユーザー:" & strUser & vbCr & _
        "現在時刻:" & strNow, vbInformation, g_cnsTitle
    GoTo TIMESTAMP_EXIT

'===================================================================================================
' OPEN不成功時のリトライWAIT(最大10回)
TIMESTAMP_OPEN_ERROR:
    strMSG = Err.Description
    cntReTry = cntReTry + 1
    If cntReTry <= 10 Then
        strMSG = ""
        ' RANDOM値を使ってWAIT
        Sleep Int(301 * Rnd + 200)
        ' エラー箇所に戻る
        Resume
    End If
    ' 失敗メッセージ
    MsgBox "打刻の出力に失敗しました。" & vbCr & " (" & strMSG & ")", _
        vbExclamation, g_cnsTitle

'===================================================================================================
' 終了
TIMESTAMP_EXIT:
    On Error GoTo 0
    Set objTs = Nothing
    Set objFso = Nothing
    ' 終了(ボタン押下後毎回閉じる)
    If Workbooks.Count <= 1 Then Application.Quit
    ThisWorkbook.Saved = True
    ThisWorkbook.Close False
End Sub

'***************************************************************************************************
'* 処理名 :FP_GetWinUser
'* 機能  :Windowsログイン名取得
'---------------------------------------------------------------------------------------------------
'* 返り値 :Windowsログイン名(String)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2007年05月20日
'* 作成者 :井上 治
'* 更新日 :2020年02月26日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Function FP_GetWinUser() As String
    '-----------------------------------------------------------------------------------------------
    Dim objWshNet As IWshRuntimeLibrary.WshNetwork                  ' WshNetwork
    Set objWshNet = New IWshRuntimeLibrary.WshNetwork
    FP_GetWinUser = objWshNet.UserName
    Set objWshNet = Nothing
End Function

'***************************************************************************************************
'* 処理名 :FP_GetMyDocumentsFolderByWsh
'* 機能  :マイドキュメントフォルダ名取得(WSH)
'---------------------------------------------------------------------------------------------------
'* 返り値 :マイドキュメントフォルダ名(String)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2007年05月20日
'* 作成者 :井上 治
'* 更新日 :2007年05月20日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Function FP_GetMyDocumentsFolderByWsh() As String
    '-----------------------------------------------------------------------------------------------
    With New WshShell
        FP_GetMyDocumentsFolderByWsh = .SpecialFolders("MyDocuments")
    End With
End Function

'***************************************************************************************************
'* 処理名 :GP_GetTimerecorderPath
'* 機能  :タイムレコーダ出力フォルダ名取得+作成
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :Arg1 = FileSystemObject(Object)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2007年05月20日
'* 作成者 :井上 治
'* 更新日 :2019年10月24日
'* 更新者 :井上 治
'* 機能説明:マイドキュメント内としています
'* 注意事項:
'***************************************************************************************************
Private Sub GP_GetTimerecorderPath(ByRef objFso As FileSystemObject)
    '-----------------------------------------------------------------------------------------------
    ' 出力パス作成済みなら終了
    If g_strPathname <> "" Then Exit Sub
    ' 出力パスを編集
    g_strPathname = objFso.BuildPath(FP_GetMyDocumentsFolderByWsh, g_cnsSubFolder)
    ' このフォルダがなければ作成
    If Not objFso.FolderExists(g_strPathname) Then
        objFso.CreateFolder g_strPathname
    End If
End Sub

'------------------------------------------<< End of Source >>--------------------------------------

■詳細説明
まず、打刻データの出力先はこのサンプルではマイドキュメント内の「TIMERECORD」フォルダとしています。

'***************************************************************************************************
'* マイドキュメントフォルダ名取得(WSH)
'***************************************************************************************************
Private Function FP_GetMyDocumentsFolderByWsh() As String
    '-----------------------------------------------------------------------------------------------
    With New WshShell
        FP_GetMyDocumentsFolderByWsh = .SpecialFolders("MyDocuments")
    End With
End Function

'***************************************************************************************************
'* タイムレコーダ出力フォルダ名取得+作成(マイドキュメント内としています)
'***************************************************************************************************
Private Sub GP_GetTimerecorderPath(ByRef objFso As FileSystemObject)
    '-----------------------------------------------------------------------------------------------
    ' 出力パス作成済みなら終了
    If g_strPathname <> "" Then Exit Sub
    ' 出力パスを編集
    g_strPathname = objFso.BuildPath(FP_GetMyDocumentsFolderByWsh, g_cnsSubFolder)
    ' このフォルダがなければ作成
    If Not objFso.FolderExists(g_strPathname) Then
        objFso.CreateFolder g_strPathname
    End If
End Sub
この部分を利用環境によって変更して下さい。
ネットワーク上に出力するような場合はこのようなプロシージャは使わず定数固定でも良いと思います。



サンプルでは「出社」「退社」の2ボタンですが、ボタンと呼び出しプロシージャを対応して追加すれば、

'***************************************************************************************************
'   「外出」打刻登録(Mode=3)
'***************************************************************************************************
Public Sub WRITE_GAISYUTSU()
    '-----------------------------------------------------------------------------------------------
    Const cnsMODE = 3
    Const cnsMODE_NAME = "「外出」"
    ' 打刻出力処理
    Call GP_WRITE_TIMESTAMP(cnsMODE, cnsMODE_NAME)
End Sub

'***************************************************************************************************
'   「外出戻り」打刻登録(Mode=4)
'***************************************************************************************************
Public Sub WRITE_MODORI()
    '-----------------------------------------------------------------------------------------------
    Const cnsMODE = 4
    Const cnsMODE_NAME = "「外出戻り」"
    ' 打刻出力処理
    Call GP_WRITE_TIMESTAMP(cnsMODE, cnsMODE_NAME)
End Sub
たとえば、このように「外出」「外出戻り」を追加するなども簡単に行なえます。



実際のファイル出力は、

    ' フルパスファイル名を編集
    strFullname = objFso.BuildPath(g_strPathname, g_cnsFilename)
    ' 追記モードでファイルをOPEN(TextStream)
    On Error GoTo TIMESTAMP_OPEN_ERROR
    Set objTs = objFso.OpenTextFile(strFullname, ForAppending, True)
    On Error GoTo 0
    ' レコードを出力
    objTs.WriteLine strRec
    ' ファイルをCLOSE
    objTs.Close
これだけの記述で一瞬で完了するわけですが、ネットワーク環境での利用では朝の定時直前に処理が大量に発生することが予想されます。
このため、ファイルのOPEN失敗の場合に0.30.5秒待機して最大10回まで再試行するように、

'===================================================================================================
' OPEN不成功時のリトライWAIT(最大10回)
TIMESTAMP_OPEN_ERROR:
    strMSG = Err.Description
    cntRETRY = cntRETRY + 1
    If cntRETRY <= 10 Then
        strMSG = ""
        ' RANDOM値を使ってWAIT
        Sleep Int(301 * Rnd + 200)
        ' エラー箇所に戻る
        Resume
    End If
    ' 失敗メッセージ
    MsgBox "打刻の出力に失敗しました。" & vbCr & " (" & strMSG & ")", _
        vbExclamation, g_cnsTitle
このようなコードで対応しています。
OPEN失敗のみで他のタイミングのエラー処置は行なっていません。)
もし、このような仕組みを考えるのであれば...  このページのサンプルは「追記書き出し」のサンプルであって、タイムレコーダのサンプルではありません。
考えてみて下さい。悪意があったらどうにでもなってしまいます。
○書き出しがテキストファイルなのでメモ帳などで改変ができてしまう。
○例えば遅刻してきたらPCのシステム時刻を一時変更すれば定時出社になってしまう。

これらを避けるには、やはりテキストデータではダメで、最低でもSQLServerなどのデータベースサーバを用意して下さい。
私はデータベースはSQLServerしか知りませんが、レコードの追加・更新時にGETDATE関数でサーバ側のシステム時刻を書き出せますから、 クライアントPCでシステム時刻を変更しても関係ありません。