excel - 文档达到特定大小后，使用 Excel VBA 归档并创建另一个文档

Question

当将数据输入 .txt 以充当日志时，它确实会变得非常大，有几 MB，并且用于 MS 的通用 txt 阅读器将有一个 conniption。有没有办法将日志放入可能存在或不存在的文件夹中？换句话说，如果文件夹不存在，创建文件夹，然后将旧日志剪切并粘贴到新文件夹中？

既然我知道多个日志可能会出现在所述日志文件夹中，那么是否有一种方法可以使今天的日期也附在日志名称上？

以为我解决了...

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

Answer 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

关于第三个查询，您可以像这样创建一个附加日期的日志文件

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