3

現在、ファイルのフォルダーをスキャンし、ファイル名のキーワードに応じてファイルを特定のフォルダーに移動する VBscript があります。

現在、スクリプトは1つのレベルのみをスキャンする必要があり（つまり、再帰的にスキャンしません）、すべてのサブフォルダーも検索する必要があります。

誰か私に手を貸してくれませんか？

編集:このスクリプトを書いて以来、ファイル名に基づいて、特定のフォルダーとサブフォルダーから特定の拡張子を持つファイルのみを他のディレクトリに移動する必要があることに気付きました。たとえば、.mp4 ファイルと .avi ファイルのみを移動する必要があります。

誰かがこれで私を助けてくれますか? 複数のことを試しましたが、再帰的なスキャンと移動、または拡張機能固有の移動が機能しません。

以下は私の現在のスクリプトです。

'========================================================
' Script to Move Downloaded TV Shows and Movies to
' correct folders based on wildcards in File Name
'========================================================

On Error Resume Next

Dim sTorrents, sTV, sMovie, sFile, oFSO

' create the filesystem object
Set oFSO = WScript.CreateObject("Scripting.FileSystemObject")

' Create Log File
Set objLog = oFSO.OpenTextFile("c:\temp\log.txt", 8, True)

' Set Variables
sTorrents = "C:\Temp\torrents\"
sTV = "C:\Temp\TV Shows\"
sMovie = "C:\Temp\Movies\"

' Scan each file in the folder
For Each sFile In oFSO.GetFolder(sTorrents).Files
' check if the file name contains TV Show Parameters
If InStr(1, sFile.Name, "hdtv", 1) OR InStr(1, sFile.Name, "s0", 1) <> 0 Then
    ' TV Show Detected - Move File
    objLog.WriteLine Now() & " - " & sFile.Name & " Detected as TV Show - Moving to " & sTV
    oFSO.MoveFile sTorrents & sFile.Name, sTV & sFile.Name
' Move all other Files to Movies Directory
Else objLog.WriteLine Now() & " - " & sFile.Name & " Detected as Movie - Moving to " & sMovie
    oFSO.MoveFile sTorrents & sFile.Name, sMovie & sFile.Name
End If

Next

If sTorrents.File.Count = 0 And sTorrents.SubFolders.Count = 0 Then
    objLog.WriteLine Now() & " - There is nothing left to Process..."
    objLog.Close
End If
4

3 に答える 3

1

いくつかのメモ:

Sub listfolders(startfolder)
Dim fs 
Dim fl1 
Dim fl2 

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set fl1 = fs.GetFolder(startfolder)

    For Each fl2 In fl1.SubFolders
        Debug.Print fl2.Path

        ''process the files
        ProcessFiles fl2.Path 

        'Recursion: lists folders for each subfolder
        listfolders fl2.Path
    Next
End Sub

''Code copied from question
Sub ProcessFiles(sPath)
    ' Scan each file in the folder
    For Each sFile In oFSO.GetFolder(sPath).Files
        ' check if the file name contains TV Show Parameters
        If InStr(1, sFile.Name, "hdtv", 1) OR InStr(1, sFile.Name, "s0", 1) <> 0 Then
            ' TV Show Detected - Move File
            objLog.WriteLine Now() & " - " _
                  & sFile.Name & " Detected as TV Show - Moving to " & sTV
            oFSO.MoveFile sTorrents & sFile.Name, sTV & sFile.Name
        ' Move all other Files to Movies Directory
        Else 
            objLog.WriteLine Now() & " - " _
            & sFile.Name & " Detected as Movie - Moving to " & sMovie
            oFSO.MoveFile sTorrents & sFile.Name, sMovie & sFile.Name
        End If
    Next
End Sub
于 2012-09-26T12:13:22.883 に答える
0

拡張子の前に、その拡張子を持つ*すべてのファイルを検索する a を付けます。例：oFSO.MoveFile (PATH\*.EXTERNSION)

于 2014-05-24T13:42:11.450 に答える
0

これは、テスト済みで機能しているフォルダーとサブフォルダー内のファイルをリストするための再帰的な機能ですが、おそらく独自のフォークフローに適応する必要があります。最適化されたものではありませんが、読みやすいです

Sub test()
  aFiles = F_ListFilesInDirAndSubDir("C:\foo\folder")
  'then, add some code to parse the array:
  For i = 0 to UBound(aFiles)
      'Move or not to move, that is what your code should tell
  Next
End Sub

Public Function F_ListFilesInDirAndSubDir(ByVal sDir)
    '===============================================================================
    'Get the list of files in a directory and in all its sub directories With the full path
    '===============================================================================
    Dim sChild      As String
    Dim aFolders    As Variant
    Dim aFiles      As Variant
    Dim aChildFiles As Variant
    Dim i           As Long
    Dim j           As Long
    F_ListFilesInDirAndSubDir = aFiles
    Set fs = CreateObject("Scripting.FileSystemObject")
    If Not fs.FolderExists(sDir) Then Exit Function

    'Get the files in the directory
    aFiles = F_ListFilesInDir(sDir)
    'Add the fullpath
    For i = 0 To UBound(aFiles)
        If aFiles(i) <> "" Then
            aFiles(i) = sDir & "\" & CStr(aFiles(i))
        End If
    Next

    'get the folders
    aFolders = F_ListFoldersInDir(sDir)

    'for each folders, push the files in the file list
    For i = 0 To UBound(aFolders)
        If aFolders(i) <> "" Then
            sChild = sDir & "\" & CStr(aFolders(i))
            'Recursive call on each folders
            aChildFiles = F_ListFilesInDirAndSubDir(sChild)
            'Push new items
            For j = 0 To UBound(aChildFiles)
                If aChildFiles(j) <> "" Then
                    ReDim Preserve aFiles(UBound(aFiles) + 1)
                    aFiles(UBound(aFiles)) = aChildFiles(j)
                End If
            Next
        End If
    Next

    F_ListFilesInDirAndSubDir = aFiles
End Function

Public Function F_ListFilesInDir(ByVal sDir)
    '===============================================================================
    'Get the list of files in a directory
    '===============================================================================
    Dim aList     As Variant
    Dim i         As Long
    Dim iChild    As Long
    Dim oFile
    Dim oFolder
    Dim oChildren
    ReDim aList(0)
    F_ListFilesInDir = aList

    Set fs = CreateObject("Scripting.FileSystemObject")

    If Not fs.FolderExists(sDir) Then Exit Function

    Set oFolder = fs.GetFolder(sDir)
    Set oChildren = oFolder.Files

    iChild = CDbl(oChildren.Count) - 1
    If iChild = -1 Then Exit Function

    ReDim aList(iChild)
    i = 0
    For Each oFile In oChildren
        aList(i) = oFile.Name
        i = i + 1
    Next

    F_ListFilesInDir = aList
End Function

Public Function F_ListFoldersInDir(ByVal sDir As String) As Variant
    '===============================================================================
    'Get the list of folders in a directory
    '===============================================================================
    Dim aList     As Variant
    Dim i         As Long
    Dim oDir
    Dim oFolder
    Dim oChildren
    ReDim aList(0)

    F_ListFoldersInDir = aList

    Set fs = CreateObject("Scripting.FileSystemObject")
    If Not fs.FolderExists(sDir) Then Exit Function

    Set oFolder = fs.GetFolder(sDir)
    Set oChildren = oFolder.SubFolders

    If oChildren.Count = 0 Then Exit Function

    ReDim aList(oChildren.Count - 1)
    i = 0
    For Each oDir In oChildren
        aList(i) = oDir.Name
        i = i + 1
    Next

    F_ListFoldersInDir = aList
End Function
于 2015-03-09T14:02:21.723 に答える