私は今朝、誰もやりたがらなかったとは信じられないタスクを解決しようとして頭を悩ませていました-それは、ファイルとサブディレクトリとすべてのファイルのディレクトリを別の場所にコピーすることですが、最大のものを厳密にコピーすることです最初にファイル。なんで？私が見る限り、これは、ファイルをコピーしてから移動し、ファイルのサイズのギャップを残す方法のために、USB フラッシュ メモリにコピーされる大きなファイルの断片化を防ぐのに役立ちます。大きなファイルはそのギャップに収まらないため、独自のファイルを作成してください。ETc など。最終結果 - 最大の最初は、すべてのコピーに使用される 1 つのギャップを意味し、結果のファイルがすべて連続して並んでいることを意味する必要があります。私は断片化されたファイルについて完全に保持しているわけではありません。それは、isos/images のような USB 上の連続したファイルを取得することです。
これが私がこれまでに得たものです-修正する2つの問題：1-ディレクトリが存在しない場合、宛先パスには1つのレベルのディレクトリのみが作成されます-存在しないものを必要なだけ作成する必要がありますまだ 2 - 最初のコピーが開始されると、このデバイスに 4g ファイルをコピーするのに 30g ほど残っているにもかかわらず、「十分なスペースがありません」と表示されます。
すべての入力を歓迎します!
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