FSO没有得到任何文件
我试图让程序复制某些字符的文件。 要复制的文件应该在今天和今天之前的100天之间。 我的程序可以运行，但是新文件夹没有显示。 我确实确定该文件是在这个date之间。 我没有得到任何错误，所以我不知道在哪里修复。 我尝试过其他方法，但都没有工作。
我尝试混合来自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
好吧，我试着添加一些评论给你一些方向。 你遇到的第一个问题是，你没有对根文件夹做任何事情 – 你试图直接进入子文件夹，这可能是为什么你说它“突出显示”在外层循环层上的行。 （突出显示的行是下一次按F8时将执行的行）。
我所做的是将复制操作分解成另一个过程，以便您可以在任何子文件夹上recursion调用它。 这只是一种方法 – 还有其他的，可能更简单的方法，但这是我想到的，因为我习惯以这种方式recursion地挖掘文件夹和logging集。
你的另一个问题是你比较date的方法。 .DateCreated属性的格式带有date和时间。 您可以直接将它与Now()函数进行比较， Now()函数返回date和时间 – 但是如果您尝试与Date()函数进行比较，则它将不起作用，因为它是不同的格式。
我不确定你想用文件扩展名来做什么。 我以为你想用它作为filter，所以这就是我用它做的。
一些注意事项：您目前正在最后告诉用户“您可以find这些文件”，但是您不检查是否属实。 您可能希望在.Copy操作之后添加一个检查，然后将结果添加到数组或某些内容中，以便可以向用户显示成功复制的文件列表以及不包含的文件。 当我testing时，我创build了我在Users目录中的文件夹，并在尝试复制不具备所需权限时遇到错误。
现在，Frompath，Topath和扩展filter都是硬编码的。 如果您打算分发此文件，或者将自己在多个位置使用，则可以使用BrowseForFolder方法向用户显示文件夹浏览器对话框，并允许他们select“发件人”和“至”文件夹。 您也可以使用InputBox从用户获取filter。 只是一个想法。
无论如何，这是我用你的代码做的。 我将variables名称改为我的命名约定，只是因为这是我习惯的 – 你可以改变它们，但是你想要的。
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