FSO 파일을 가져 오지 못했습니다.

Question

특정 문자가있는 파일을 복사하는 프로그램이 있습니다. 복사 할 파일은 오늘 날짜와 오늘 날짜 사이에 있어야합니다. 내 프로그램을 실행할 수 있지만 새 폴더에 아무것도 표시되지 않습니다. 파일이 그 날짜 사이에 있는지 확인했습니다. 나는 어떤 오류도 없으므로 어디에서 수정해야할지 모른다. 다른 방법을 시도했지만 그 중 아무 것도 작동하지 않았습니다.

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 디렉토리에 있던 폴더를 만들었고 필요한 권한이없는 복사본을 만들 때 오류가 발생했습니다.

지금부터는 시작 경로, 끝 경로 및 확장 필터가 모두 하드 코드됩니다. 이 파일을 배포하거나 여러 위치에서 직접 사용하려는 경우 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