文档达到特定大小后，使用Excel VBA进行存档和创build另一个文档

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

因为我知道在这个日志文件夹中会有多个日志文件的可能性，会不会有一种方法使得日志文件名中还有今天的date呢？

想我解决了它…

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

从另一个问题来看，很明显你知道如何创build一个日志文件。

从上面的问题中，我可以总结出这是你的问题

1. 检查文件夹是否存在
2. 创build一个文件夹
3. 将date添加到日志文件的名称
4. 检查文件大小
5. 移动文件

所以让我们一个接一个。

检查文件夹是否存在。 您可以使用DIRfunction来检查。 看下面的例子

 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创build一个文件夹。 看到这个例子

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

关于第三个查询，你可以像这样创build一个附加date的日志文件

 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 

而要将文件从一个目录移动到另一个目录，您可以使用NAMEfunction。 看到这个例子。

 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