Question

我今天早上一直在试图解决一个我无法相信以前没有人想过的任务 - 那就是复制一个文件目录＆amp;子目录所有文件都转到另一个位置，但首先严格复制BIGGEST文件。为什么？因为，从我所看到的，这将有助于停止将大文件分段复制到USB闪存，因为它似乎复制文件然后移动它的方式，留下文件大小的间隙。更大的文件不能适应这个差距，所以自己做。 ETc等。最终结果 - 最大的首先应该意味着所有副本使用1个间隙，结果文件在它之后连续排列。我不是关于碎片文件的保持，它是在USB上获得连续文件，如isos / images。

所以这就是我到目前为止所解决的2个问题： 1 - 如果目标路径不存在，则只在目标路径上创建一级目录 - 我需要它来尽可能多地创建目标路径 2 - 当第一个副本开始时，它表示“没有足够的空间”，即使此设备上还剩30g以复制4g文件。

欢迎所有投入！

strPath = "C:\Data\Images\"
strDestPath = "E:\"
Set DataList = CreateObject("ADODB.Recordset")
DataList.Fields.Append "strFilePath", 200, 255 ' adVarChar
DataList.Fields.Append "strFileName", 200, 255 ' adVarChar
DataList.Fields.Append "strFileSize", 3, 4 ' adDouble
DataList.Open

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strPath)

If Right(strPath, 1) = "\" Then strPath = Left(strPath, Len(strPath) - 1)
If Right(strDestPath, 1) = "\" Then strDestPath = Left(strDestPath, Len(strDestPath) - 1)

'wscript.echo strPath & " " & strDestPath

For Each objFile In objFolder.Files
 Call ListFile (objFile, objFolder)
Next

DoSubfolders objFSO.GetFolder(strPath)

DataList.Sort = "strFileSize DESC"
DataList.MoveFirst
Do Until DataList.EOF
 strFilePath = DataList.Fields.Item("strFilePath")
 strFile = DataList.Fields.Item("strFileName")
 strFileName = DataList.Fields.Item("strFileSize")
 strFileSizeLG = Len(strFileSize)
 intPadding = 15 - strFileSizeLG
 strDisplayName = strFile & Space(intPadding)

 'wscript.echo strFilePath & "\" & strFile & " == " & strDestPath & Replace(strFilePath,strPath,"") & "\" & strFile
 'wscript.echo strFilePath & "\" & strFile & "," & strDestPath & Replace(strFilePath,strPath,"") & "\"

 If Not(objFSO.FileExists(strDestPath & Replace(strFilePath,strPath,"") & "\" & strFile)) Then
  If Not(objFSO.FolderExists(strDestPath & Replace(strFilePath,strPath,"") & "\")) Then
   objFSO.CreateFolder strDestPath & Replace(strFilePath,strPath,"")
  End If
  wscript.echo strFilePath & "\" & strFile, strDestPath & Replace(strFilePath,strPath,"") & "\"
  objFSO.CopyFile strFilePath & "\" & strFile, strDestPath & Replace(strFilePath,strPath,"") & "\",True
 End If
 DataList.MoveNext
Loop

Sub DoSubFolders(Folder)
    For Each Subfolder in Folder.SubFolders
        Set objFolder = objFSO.GetFolder(Subfolder.Path)
        Set colFiles = objFolder.Files
        For Each objFile in colFiles
            Call ListFile (objFile, objFolder)
        Next
        DoSubFolders Subfolder
    Next
End Sub

Sub ListFile (objFile, objFolder)
 DataList.AddNew
 DataList("strFilePath") = objFSO.GetAbsolutePathName(objFolder)
 DataList("strFileName") = objFile.Name
 DataList("strFileSize") = Int(objFile.Size/1000)
 If DataList("strFileSize") = 0 Then DataList("strFileSize") = 1
 DataList.Update
End Sub

Set DataList = Nothing : Set objFSO = Nothing : Set objFolder = Nothing

我现在已经使用了下面建议的代码，并且让这个新脚本有一些错误检查和修复。但是我仍然遇到无法复制到USB的问题。我已经改变了C驱动器的路径并且它可以工作 - 所以我只能假设它是因为最大的文件是4.6g而USB是FAT32，理论上限制为4G文件（虽然windows拷贝到了很好吗？）

Dim strRootPath, strDestPath
Const dictKey = 1
Const dictItem = 2
Dim tmp
Dim oFSO, oDict

'------------------- CHANGE PATHS --------------------------
strRootPath = "C:\Data\Images"
strDestPath = "C:\Copy" '"E:\"
'-----------------------------------------------------------

Main

Sub Main()
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oDict = CreateObject("Scripting.Dictionary")
    If Right(strRootPath, 1) <> "\" Then strRootPath = strRootPath & "\"
    If Right(strDestPath, 1) <> "\" Then strDestPath = strDestPath & "\"
    If Not oFSO.FolderExists(strRootPath) Then : wscript.echo "Missing Source : " & strRootPath : wscript.quit
    If Not oFSO.FolderExists(strDestPath) Then : wscript.echo "Missing Destination : " & strDestPath : wscript.quit
    ProcessFolder strRootPath
    CopyBiggestFirst
    Set oDict = Nothing
    Set oFSO = Nothing
End Sub

Sub ProcessFolder(sFDR)
    Dim oFDR, oFile
    For Each oFile In oFSO.GetFolder(sFDR).Files
        'Wscript.Echo oFile.Size & vbTab & oFile.Path
        tmp = Int(oFile.Size/1000)
        if tmp = 0 Then tmp = 1
        oDict.Add oFile.Path, tmp ' Key: FilePath, Value: Size
    Next
    For Each oFDR In oFSO.GetFolder(sFDR).SubFolders
        ProcessFolder (oFDR.Path)
    Next
End Sub

Sub CopyBiggestFirst()
    Dim oKeys, oItems, sFileSrc, sFileDst
    'Wscript.Echo vbCrLf & "CopyBiggestFirst()"
    SortDictionary oDict, dictItem
    oKeys = oDict.Keys
    oItems = oDict.Items
    For i = 0 To oDict.Count - 1
        'Wscript.Echo oKeys(i) & " | " & oItems(i)
        sFileSrc = oKeys(i)
        sFileDst = Replace(sFileSrc, strRootPath, strDestPath)
        CreateFolder oFSO.GetFile(sFileSrc).ParentFolder.Path
        oFSO.CopyFile sFileSrc, sFileDst
    Next
End Sub

Sub CreateFolder(sFDR)
    Dim sPath
    sPath = Replace(sFDR, strRootPath, strDestPath)
    If Not oFSO.FolderExists(sPath) Then
        CreateFolder (oFSO.GetFolder(sFDR).ParentFolder.Path)
        oFSO.CreateFolder sPath
    End If
End Sub

Function GetFolder(sFile)
    GetFolder = oFSO.GetFile(sFile).ParentFolder.Path
End Function

Function SortDictionary(oDict, intSort)
    Dim strDict()
    Dim objKey
    Dim strKey, strItem
    Dim X, Y, Z
    Z = oDict.Count
    If Z > 1 Then
        ReDim strDict(Z, 2)
        X = 0
        For Each objKey In oDict
            strDict(X, dictKey) = CStr(objKey)
            'wscript.echo oDict(objKey)
            strDict(X, dictItem) = CLng(oDict(objKey))
            X = X + 1
        Next
        For X = 0 To (Z - 2)
            For Y = X To (Z - 1)
                If strDict(X, intSort) < strDict(Y, intSort) Then
                    strKey = strDict(X, dictKey)
                    strItem = strDict(X, dictItem)
                    strDict(X, dictKey) = strDict(Y, dictKey)
                    strDict(X, dictItem) = strDict(Y, dictItem)
                    strDict(Y, dictKey) = strKey
                    strDict(Y, dictItem) = strItem
                End If
            Next
        Next
        oDict.RemoveAll
        For X = 0 To (Z - 1)
            oDict.Add strDict(X, dictKey), strDict(X, dictItem)
        Next
    End If
End Function

Answer 1

试试这个：

Const strRootPath = "C:\Data\Images\"
Const strDestPath = "E:\"
Const dictKey = 1
Const dictItem = 2

Dim oFSO, oDict

Main

Sub Main()
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oDict = CreateObject("Scripting.Dictionary")
    ProcessFolder strRootPath
    CopyBiggestFirst
    Set oDict = Nothing
    Set oFSO = Nothing
End Sub

Sub ProcessFolder(sFDR)
    Dim oFDR, oFile
    For Each oFile In oFSO.GetFolder(sFDR).Files
        Wscript.Echo oFile.Size & vbTab & oFile.Path
        oDict.Add oFile.Path, oFile.Size ' Key: FilePath, Value: Size
    Next
    For Each oFDR In oFSO.GetFolder(sFDR).SubFolders
        ProcessFolder (oFDR.Path)
    Next
End Sub

Sub CopyBiggestFirst()
    Dim oKeys, oItems, sFileSrc, sFileDst
    Wscript.Echo vbCrLf & "CopyBiggestFirst()"
    SortDictionary oDict, dictItem
    oKeys = oDict.Keys
    oItems = oDict.Items
    For i = 0 To oDict.Count - 1
        Wscript.Echo oKeys(i) & " | " & oItems(i)
        sFileSrc = oKeys(i)
        sFileDst = Replace(sFileSrc, strRootPath, strDestPath)
        CreateFolder oFSO.GetFile(sFileSrc).ParentFolder.Path
        oFSO.CopyFile sFileSrc, sFileDst
    Next
End Sub

Sub CreateFolder(sFDR)
    Dim sPath
    sPath = Replace(sFDR, strRootPath, strDestPath)
    If Not oFSO.FolderExists(sPath) Then
        CreateFolder (oFSO.GetFolder(sFDR).ParentFolder.Path)
        oFSO.CreateFolder sPath
    End If
End Sub

Function GetFolder(sFile)
    GetFolder = oFSO.GetFile(sFile).ParentFolder.Path
End Function

Function SortDictionary(oDict, intSort)
    Dim strDict()
    Dim objKey
    Dim strKey, strItem
    Dim X, Y, Z
    Z = oDict.Count
    If Z > 1 Then
        ReDim strDict(Z, 2)
        X = 0
        For Each objKey In oDict
            strDict(X, dictKey) = CStr(objKey)
            strDict(X, dictItem) = CLng(oDict(objKey))
            X = X + 1
        Next
        For X = 0 To (Z - 2)
            For Y = X To (Z - 1)
                If strDict(X, intSort) < strDict(Y, intSort) Then
                    strKey = strDict(X, dictKey)
                    strItem = strDict(X, dictItem)
                    strDict(X, dictKey) = strDict(Y, dictKey)
                    strDict(X, dictItem) = strDict(Y, dictItem)
                    strDict(Y, dictKey) = strKey
                    strDict(Y, dictItem) = strItem
                End If
            Next
        Next
        oDict.RemoveAll
        For X = 0 To (Z - 1)
            oDict.Add strDict(X, dictKey), strDict(X, dictItem)
        Next
    End If
End Function

Answer 2

OK！我现在已经对两种风格的脚本进行了排序，并添加了一些捕获并通知消息 - 对我自己无法帮助;）我还发现我可以使用幽灵浏览器重新调整我的幽灵图像，使它们<4g以便现在它们可以复制到USB - yay！所有这一切的唯一缺点是不知何故一些文件仍然碎片但是嘿 - 这些脚本仍然按照预期完美运行:)请你选择！

Dim strRootPath, strDestPath
Const dictKey = 1
Const dictItem = 2
Dim tmp, totalSize
Dim oFSO, oDict

'------------------- CHANGE PATHS --------------------------
strRootPath = "C:\Data\Images\"
strDestPath = "E:\"
'-----------------------------------------------------------

Main

Sub Main()
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oDict = CreateObject("Scripting.Dictionary")
    If Right(strRootPath, 1) <> "\" Then strRootPath = strRootPath & "\"
    If Right(strDestPath, 1) <> "\" Then strDestPath = strDestPath & "\"
    If Not oFSO.FolderExists(strRootPath) Then : wscript.echo "Missing Source : " & strRootPath : wscript.quit
    If Not oFSO.FolderExists(strDestPath) Then : wscript.echo "Missing Destination : " & strDestPath : wscript.quit
    ProcessFolder strRootPath

    If totalSize = 0 Then : wscript.echo "No files to copy!" : wscript.quit
    totalSize = totalSize/1024
    If totalSize < 1 Then totalSize = 1
    wscript.echo FormatNumber(totalSize,2) & " Mb to copy - press OK then wait for 'Finished' message"

    CopyBiggestFirst
    Set oDict = Nothing
    Set oFSO = Nothing
    wscript.echo "Finished!"
End Sub

Sub ProcessFolder(sFDR)
    Dim oFDR, oFile
    For Each oFile In oFSO.GetFolder(sFDR).Files
        'Wscript.Echo oFile.Size & vbTab & oFile.Path
        tmp = Int(oFile.Size/1024)
        if tmp < 1 Then tmp = 1
        oDict.Add oFile.Path, tmp ' Key: FilePath, Value: Size
        totalSize = totalSize + tmp
    Next
    For Each oFDR In oFSO.GetFolder(sFDR).SubFolders
        ProcessFolder (oFDR.Path)
    Next
End Sub

Sub CopyBiggestFirst()
    Dim oKeys, oItems, sFileSrc, sFileDst
    'Wscript.Echo vbCrLf & "CopyBiggestFirst()"
    SortDictionary oDict, dictItem
    oKeys = oDict.Keys
    oItems = oDict.Items
    For i = 0 To oDict.Count - 1
        'Wscript.Echo oKeys(i) & " | " & oItems(i)
        sFileSrc = oKeys(i)
        sFileDst = Replace(sFileSrc, strRootPath, strDestPath)
        CreateFolder oFSO.GetFile(sFileSrc).ParentFolder.Path
        oFSO.CopyFile sFileSrc, sFileDst
    Next
End Sub

Sub CreateFolder(sFDR)
    Dim sPath
    sPath = Replace(sFDR, strRootPath, strDestPath)
    If Not oFSO.FolderExists(sPath) Then
        CreateFolder (oFSO.GetFolder(sFDR).ParentFolder.Path)
        oFSO.CreateFolder sPath
    End If
End Sub

Function GetFolder(sFile)
    GetFolder = oFSO.GetFile(sFile).ParentFolder.Path
End Function

Function SortDictionary(oDict, intSort)
    Dim strDict()
    Dim objKey
    Dim strKey, strItem
    Dim X, Y, Z
    Z = oDict.Count
    If Z > 1 Then
        ReDim strDict(Z, 2)
        X = 0
        For Each objKey In oDict
            strDict(X, dictKey) = CStr(objKey)
            'wscript.echo oDict(objKey)
            strDict(X, dictItem) = CLng(oDict(objKey))
            X = X + 1
        Next
        For X = 0 To (Z - 2)
            For Y = X To (Z - 1)
                If strDict(X, intSort) < strDict(Y, intSort) Then
                    strKey = strDict(X, dictKey)
                    strItem = strDict(X, dictItem)
                    strDict(X, dictKey) = strDict(Y, dictKey)
                    strDict(X, dictItem) = strDict(Y, dictItem)
                    strDict(Y, dictKey) = strKey
                    strDict(Y, dictItem) = strItem
                End If
            Next
        Next
        oDict.RemoveAll
        For X = 0 To (Z - 1)
            oDict.Add strDict(X, dictKey), strDict(X, dictItem)
        Next
    End If
End Function

和

Dim fso
Dim strRootSource, strRootDest
Dim rsFiles
dim totalSize
Set fso = CreateObject("Scripting.FileSystemObject")

'------------------- CHANGE PATHS --------------------------
strRootSource = "c:\data\images\"
strRootDest = "e:\"
'-----------------------------------------------------------

If Right(strRootSource, 1) <> "\" Then strRootSource = strRootSource & "\"
If Right(strRootDest, 1) <> "\" Then strRootDest = strRootDest & "\"
If Not fso.FolderExists(strRootSource) Then : wscript.echo "Missing Source : " & strRootSource : wscript.quit
If Not fso.FolderExists(strRootDest) Then : wscript.echo "Missing Destination : " & strRootDest : wscript.quit

CopyTree strRootSource
wscript.echo "Finished!"

Sub CopyTree(strSource) ', strDest)
    Set rsFiles = CreateObject("ADODB.Recordset")
    rsFiles.Fields.Append "Source", 200, 560 'double 255 byte limit ' 255 ' adVarChar
    rsFiles.Fields.Append "Destination", 200, 560 'double 255 byte limit '255 ' adVarChar
    rsFiles.Fields.Append "Size", 20 ' adBigInt      '3, 4 ' adDouble
    rsFiles.Open
    rsFiles.Sort = "Size DESC"

    Recurse strSource

    If totalSize = 0 Then : wscript.echo "No files to copy!" : wscript.quit
    totalSize = totalSize/1024000
    If totalSize < 1 Then totalSize = 1
    wscript.echo FormatNumber(totalSize,2) & " Mb to copy - press OK then wait for 'Finished' message"

    ' Source hierarchy scanned and duplicated to destination
    rsFiles.MoveFirst
    Do Until rsFiles.EOF
        fso.CopyFile rsFiles("Source"), rsFiles("Destination")
        rsFiles.MoveNext
    Loop
End Sub


Function Recurse(strSource)

    Dim myitem, subfolder
    For Each myitem In fso.GetFolder(strSource).Files
        rsFiles.AddNew
        rsFiles("Source") = myitem.Path
        rsFiles("Destination") = Replace(myitem.Path, fso.GetFolder(strRootSource), fso.GetFolder(strRootDest))
        rsFiles("Size") = myitem.Size
        totalSize = totalSize + myitem.Size
        ' Build any necessary subfolder in destination as we walk down tree
        subfolder = fso.GetParentFolderName(rsFiles("Destination"))
        If Not fso.FolderExists(subfolder) Then fso.CreateFolder subfolder
    Next

    For Each myitem In fso.GetFolder(strSource).SubFolders
        Recurse myitem.Path
    Next

End Function

VBS首先复制最大的文件

2 个答案: