1

当将数据输入 .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
4

2 回答 2

4

从您的另一个问题中，很明显您知道如何创建日志文件。

根据您的上述问题，我可以总结出这是您的查询

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

因此，让我们一一介绍。

检查文件夹是否存在。您可以使用该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
于 2012-08-30T20:01:53.153 回答
0 
Sub MoveFiles()
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet1")

Dim MyFile As String
Inlocation = ws.Range("A1").Value & "\"
Lastdate = Format(ws.Range("A3").Value, "DD-MM-YYYY")
Outlocation = ws.Range("A2").Value
Foulocation = Outlocation & "\" & Lastdate
MyFile = Dir(Inlocation & "*.*")

Set oFSO = CreateObject("Scripting.FileSystemObject")
'Check Specified Folder exists or not
If Not oFSO.FolderExists(Foulocation) Then
    'If Folder is available
    MkDir Foulocation
End If

Do Until MyFile = ""
 oFSO.CopyFile Inlocation & MyFile, Foulocation & "\", True
 If Inlocation <> Foulocation Then
 oFSO.DeleteFile Inlocation & MyFile
 End If
 'Name Inlocation & MyFile As Foulocation & "\" & MyFile
 MyFile = Dir
Loop
MsgBox "Files successfully moved to location " & Foulocation

End Sub
于 2021-08-06T09:11:48.467 回答