FSO沒有得到任何文件

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

好的，我試着添加一些評論給你一些方向。 你遇到的第一個問題是，你沒有對根文件夾做任何事情 - 你試圖直接進入子文件夾，這可能是爲什麼你說它「突出顯示」外層循環層上的行。 （突出顯示的行是下一次按F8時將執行的行。）

我所做的是將複製操作分解爲另一個過程，以便您可以在任何子文件夾上遞歸調用它。這只是一種方法 - 還有其他的，可能更簡單的方法，但是這讓我想起了我，因爲我習慣以這種方式遞歸地在文件夾和記錄集中挖掘。

您的另一個問題是您的比較日期的方法。 .DateCreated財產的格式帶有日期和時間。您可以直接將它與Now()函數進行比較，該函數返回日期和時間 - 但如果您嘗試與Date()函數進行比較，則它將不起作用，因爲它是不同的格式。

我不確定你想用文件擴展名來做什麼。我以爲你想用它作爲過濾器，所以我就是這麼做的。

一些注意事項： 您當前正在告訴用戶最終「您可以找到文件」，但您並未檢查是否屬實。您可能希望在.Copy操作之後添加支票，然後將結果添加到數組或某些內容中，以便向用戶顯示已成功複製的文件列表以及沒有的文件。當我測試時，我創建了我在Users目錄中的文件夾，並在嘗試複製不具備所需權限時出現錯誤。

現在，From路徑，To path和extension filter都是硬編碼的。如果您計劃分發此文件或將在多個位置自行使用它，則可以使用BrowseForFolder方法向用戶顯示文件夾瀏覽器對話框，並允許他們選擇From和To文件夾。您也可以使用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