1

ログとして機能する .txt にデータを入力すると、かなり大きくなり、数 MB になり、MS 用の一般的な txt リーダーではエラーが発生します。存在する場合と存在しない場合があるフォルダーにログを入れる方法はありますか? つまり、フォルダが存在しない場合は、フォルダを作成し、古いログを切り取り、新しいフォルダに貼り付けますか?

上記のログフォルダに複数のログが存在する可能性があることはわかっているので、ログ名に今日の日付も付けられるようにする方法はありますか?

私はそれを解決したと思います...

If FileLen(sLogFileName) > 3145728# Then
    sLogFileName = "Open Order Log - " & Format(Date, "dd-mm-yyyy")
    Name sLogFileName As "ThisWorkbook.path & Application.PathSeparator & \Temp\Open Order Log - " & Format(Date, "dd-mm-yyyy")
End If
4

2 に答える 2

4

他の質問から、ログファイルの作成方法を知っていることは明らかです。

そして、あなたの上記の質問から、これはあなたの質問であると要約することができます

  1. フォルダが存在するかどうかを確認します
  2. フォルダの作成
  3. ログファイルの名前に日付を追加する
  4. ファイルサイズの確認
  5. ファイルの移動

それでは、それらを1つずつ取り上げましょう。

フォルダが存在するかどうかを確認してください。このDIR関数を使用して、それを確認できます。以下の例を参照してください

Public Function DoesFolderExist(strFullPath As String) As Boolean
    On Error GoTo Whoa
    If Not Dir(strFullPath, vbDirectory) = vbNullString Then _
    DoesFolderExist = True
Whoa:
    On Error GoTo 0
End Function

次のクエリに関しては、を使用MKDIRしてフォルダを作成できます。この例を参照してください

Sub Sample()
    MkDir "C:\Sample"
End Sub

3番目のクエリに関しては、次のように日付が追加されたログファイルを作成できます。

Sub Sample()
    Dim FlName As String

    FlName = "Sample File - " & Format(Date, "dd-mm-yyyy")

    Debug.Print FlName
End Sub

ファイルサイズを確認するには、このFileLen関数を使用できます。この例を参照してください

Sub Sample()
    Dim FileNM As String

    FileNM = "C:\Sample.txt"
    Debug.Print "The File size of " & FileNM & " is " & _
    FileLen(FileNM) & " bytes"
End Sub

また、あるディレクトリから別のディレクトリにファイルを移動するには、このNAME関数を使用できます。この例を参照してください。

Sub Sample()
    Dim FileNM As String

    FileNM = "C:\Sample.txt"
    Name FileNM As "C:\Temp\Sample.txt"
End Sub

だから今、あなたはあなたが望むものを達成するためにこれらすべてをまとめることができます:)

フォローアップ（チャットから）

これが私たちがついに到達したものです

Option Explicit

Dim PreviousValue

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    PreviousValue = Target(1).Value
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sLogFileName As String, ArchiveFileName As String
    Dim ArchFolder As String, sLogMessage As String
    Dim nFileNum As Long
    Dim NewVal

    On Error GoTo Whoa

    Application.EnableEvents = False

    sLogFileName = ThisWorkbook.path & Application.PathSeparator & _
    "Open Order Log.txt"

    If Not Target.Cells.Count > 1 Then
        If Target.Value <> PreviousValue Then
            '~~> Check if the Log File exists
            If DoesFileFldrExist(sLogFileName) = True Then
                '~~> Check for the File Size
                If FileLen(sLogFileName) > 3145728 Then
                    '~~> Check if the "Log History" folder exists
                    ArchFolder = ThisWorkbook.path & _
                    Application.PathSeparator & "Log History"

                    '~~> If the "Log History" folder doesn't exist, then create it
                    If DoesFileFldrExist(ArchFolder) = False Then
                        MkDir ArchFolder
                    End If

                    '~~> Generate a new file name for the archive file
                    ArchiveFileName = ArchFolder & Application.PathSeparator & _
                    "Open Order Log - " & Format(Date, "dd-mm-yyyy") & ".txt"

                    '~~> Move the file
                    Name sLogFileName As ArchiveFileName
                End If
            End If

            '~~> Check if the cell is blank or not
            If Len(Trim(Target.Value)) = 0 Then _
            NewVal = "Blank" Else NewVal = Target.Value

            sLogMessage = Now & Application.UserName & _
            " changed cell " & Target.Address & " from " & _
            PreviousValue & " to " & NewVal

            nFileNum = FreeFile

            '~~> If the log file exists then append to it else create
            '~~> a new output file
            If DoesFileFldrExist(sLogFileName) = True Then
                Open sLogFileName For Append As #nFileNum
            Else
                Open sLogFileName For Output As #nFileNum
            End If

            Print #nFileNum, sLogMessage
            Close #nFileNum
        End If
    End If

LetsContinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

Public Function DoesFileFldrExist(strFullPath As String) As Boolean
    On Error GoTo Whoa
    If Not Dir(strFullPath, vbDirectory) = vbNullString _
    Then DoesFileFldrExist = True
Whoa:
    On Error GoTo 0
End Function
于 2012-08-30T20:01:53.153 に答える