Question

我正在尝试让程序复制具有特定字符的文件。要复制的文件应该在今天的日期和今天之前的100天之间。我的程序可以运行，但新文件夹上没有任何内容。我确实确保文件在这些日期之间。我没有任何错误，所以我不知道在哪里修复。我尝试过其他方法，但都没有。

我尝试混合来自http://www.rondebruin.nl/win/s3/win026.htm的代码。我正在玩它，只有copy_folder()正在工作。我收到运行时错误'53' - Copy_Certain_Files_In_Folder()上找不到文件，Copy_Files_Dates()也没有给我任何内容。

无论如何，我的代码出了什么问题，如何将FileExt合并到下面的代码中？谢谢！

Sub CopyPasteFiles()

Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim Fdate As Date
Dim FileExt As String
Dim objFile As Object
Dim objFolder As Object

FromPath = "C:\Users\Run"  '<< Change
ToPath = "C:\Users\Test"    '<< Change
FileExt = "*BT.csv"

If Right(FromPath, 1) <> "\" Then
    FromPath = FromPath & "\"
End If

Set FSO = CreateObject("scripting.filesystemobject")

If FSO.FolderExists(FromPath) = False Then
    MsgBox FromPath & " doesn't exist"
    Exit Sub
End If

If FSO.FolderExists(ToPath) = False Then
    MsgBox ToPath & " doesn't exist"
    Exit Sub
End If

For Each objFolder In FSO.GetFolder(FromPath).SubFolders
    For Each objFile In objFolder.Files
            Fdate = Int(objFile.DateCreated)
            If Fdate >= Date And Fdate <= Format(DateAdd("d", -100, Date), "dd mmmm yyyy") Then
                objFile.Copy ToPath
            End If
    Next objFile
Next objFolder

MsgBox "You can find the files from " & FromPath & " in " & ToPath

End Sub

Answer 1

好的，我试着添加一些评论给你一些方向。你遇到的第一个问题是，你没有对根文件夹做任何事情 - 你试图直接进入子文件夹，这可能就是你说它突然强调的原因了＃34;外环层上的线条。（突出显示的行是接下来按F8时将执行的行。）

我所做的是将复制操作分解为另一个过程，以便您可以在任何子文件夹上递归调用它。它只是一种方法 - 还有其他的，可能更简单的方式，但它是我想到的，因为我曾经习惯于以这种方式递归地挖掘文件夹和记录集。

您遇到的另一个问题是比较日期的方法。 .DateCreated属性的格式包含日期和时间。您可以直接将其与Now()函数进行比较，该函数会返回日期和时间 - 但如果您尝试与Date()函数进行比较，则它将无法正常工作，因为它的格式不同。

我不确定你要对文件扩展名做什么。我以为你想把它用作过滤器，这就是我用它做的事情。

一些注意事项：您目前正在告诉用户最终＆＃34;您可以找到来自＆＃34;的文件。但你不是在检查是否属实。您可能希望在.Copy操作后添加检查，然后将结果添加到数组或其他内容，以便向用户显示已成功复制的文件列表和未成功复制的文件。当我进行测试时，我创建了您在Users目录中的文件夹，并且在尝试复制没有所需权限时出错。

现在，From路径，To路径和扩展名过滤器都是硬编码的。如果您计划分发此内容或将自己在多个位置使用它，您可以使用BrowseForFolder方法向用户显示文件夹浏览器对话框，并允许他们选择“从”和“到”文件夹。您还可以使用InputBox从用户处获取过滤器。只是一个想法。

无论如何，这是我对你的代码所做的。我将变量名称更改为我的命名约定只是因为我已经习惯了 - 您可以根据需要更改它们。

Option Explicit

Public Sub CopyPasteFiles()
    'Declare variables
        Dim SRfso                   As Scripting.FileSystemObject
        Dim strFrom                 As String
        Dim strTO                   As String
        Dim strExtFilter             As String
        Dim SRfolderA               As Scripting.Folder
        Dim SRfolderB               As Scripting.Folder

    'Are you always going to hardcode these or do you want to be able to browse for a folder?
        strFrom = "C:\Users\Run"  '<< Change
        strTO = "C:\Users\Test"    '<< Change

    'I'm not sure what your intent is with this - I assumed you wanted to filter by file extension.
        strExtFilter = "*BT.CSV"

    'Prep the folder path
        If Right(strFrom, 1) <> "\" Then
            strFrom = strFrom & "\"
        End If

    'Intialize the FileSystemObject
        Set SRfso = New Scripting.FileSystemObject

        'Verify input and output folders exist. Inform user if they don't.
            If SRfso.FolderExists(strFrom) = False Then
                MsgBox strFrom & " doesn't exist"
                Exit Sub
            End If

            If SRfso.FolderExists(strTO) = False Then
                MsgBox strTO & " doesn't exist"
                Exit Sub
            End If

    'Get the input folder using the FileSystemObject
        Set SRfolderA = SRfso.GetFolder(strFrom)

    'Call the routine that copies the files
        MoveTheFiles SRfolderIN:=SRfolderA, strFolderOUT:=strTO ', strExtFilter:=strExtFilter

    'Inform the user where they can find the files. CAUTION: You may be misinforming the user.
        MsgBox "You can find the files from " & strFrom & " in " & strTO

End Sub

Private Sub MoveTheFiles(ByRef SRfolderIN As Scripting.Folder, _
                            ByRef strFolderOUT As String, _
                            Optional ByRef strExtFilter As String = "*.*", _
                            Optional ByRef blnSUBFOLDERS As Boolean = True)
'This routine copies the files.  It requires two arguments.  First, it requires the root folder as folder object from the scripting library. _
 Second, it requires the output path as a string.  There are two optional arguments. The first allows you _
 to use a text filter as a string.  The second is a boolean that tells us whether or not to move files in subfolders - the default is true.

    'Delcare variables
        Dim SRfileA                 As Scripting.File
        Dim SRfolderCol             As Scripting.Folders
        Dim SRfolderA               As Scripting.Folder
        Dim datCreated              As Date
        Dim lngFX                   As Long
        Dim blnResult               As Boolean

    'Find the file extension in the filter
        lngFX = InStrRev(strExtFilter, ".", , vbTextCompare)

    'Move the files from the root folder
        For Each SRfileA In SRfolderIN.Files
            'Only work with files that contain the filter criteria
                If Ucase(Mid(SRfileA.Name, InStrRev(SRfileA.Name, ".", , vbTextCompare) - (Len(strExtFilter) - lngFX) + 1, Len(strExtFilter))) Like Ucase(strExtFilter) Then
                'Only work with files that were created within the last 100 days
                    datCreated = SRfileA.DateCreated
                        If datCreated <= Now And (datCreated >= DateAdd("d", -100, Now())) Then
                            SRfileA.Copy strFolderOUT
                        End If
                End If
        Next

    'Check if the calling procedure indicated we are supposed to move subfolder files as well
        If blnSUBFOLDERS Then
        'Check that we have subfolders to work with
            Set SRfolderCol = SRfolderIN.SubFolders
                If SRfolderCol.Count > 0 Then
                        For Each SRfolderA In SRfolderIN.SubFolders
                            MoveTheFiles SRfolderIN:=SRfolderA, strFolderOUT:=strFolderOUT, strExtFilter:=strExtFilter, blnSUBFOLDERS:=blnSUBFOLDERS
                        Next
                End If
        End If

End Sub

FSO没有获取任何文件

1 个答案: