简体   繁体   English

"用于跨网络复制文件和文件夹的 VBS 脚本"

[英]VBS script to copy files and folders across network

I needed to copy all of my photos from my old laptop to my new laptop.我需要将所有照片从旧笔记本电脑复制到新笔记本电脑。 This is a quick and dirty script that I put together (based on other scripts on this site) to copy files from one network location to another.这是一个快速而肮脏的脚本,我将它放在一起(基于此站点上的其他脚本),用于将文件从一个网络位置复制到另一个网络位置。 I wanted the process to be able to recover in case of a network copy error because the total time to copy all of my photos was 40 hours.我希望该过程能够在网络复制错误的情况下恢复,因为复制我所有照片的总时间是 40 小时。

sourceRoot and targetRoot is the beginning part of the file path to replace between locations. sourceRoot 和 targetRoot 是要在位置之间替换的文件路径的开始部分。 lastFileLog is a file used to keep track of the last file that was copied. lastFileLog 是用于跟踪上次复制的文件的文件。 This is needed to recover from a partial copy.这是从部分副本中恢复所必需的。 Windows seems to allocate the full file size even when the file fails to copy.即使文件无法复制,Windows 似乎也会分配完整的文件大小。 So I just keep track of the last file to copy it again on failure.所以我只是跟踪最后一个文件以在失败时再次复制它。 objStartFolder is the starting path on the source network location. objStartFolder 是源网络位置的起始路径。

'initialize paths
objStartFolder = "\\owner-pc\d\pics"
lastFileLog = "c:\Files\misc\archive.log"
sourceRoot = "\\owner-pc\d"
targetRoot = "c:\Files"


Set objFSO = CreateObject("Scripting.FileSystemObject")

'read log
Set objFile = objFSO.OpenTextFile(lastFileLog)
Do Until objFile.AtEndOfStream
    replacefile= objFile.ReadLine
    Wscript.Echo "This file will be replaced: " & replacefile
Loop
objFile.Close

'copy files
Set objFolder = objFSO.GetFolder(objStartFolder)
ShowSubfolders objFSO.GetFolder(objStartFolder)

'clear log
Set objFileLog = objFSO.CreateTextFile(lastFileLog,True)
objFileLog.Write ""
objFileLog.Close

Sub ShowSubFolders(Folder)
    For Each Subfolder in Folder.SubFolders

        Wscript.Echo Subfolder.Path

        if not(objFSO.FolderExists(replace(Subfolder.Path,sourceRoot,targetRoot))) then
          objFSO.CreateFolder(replace(Subfolder.Path,sourceRoot,targetRoot))
        end if

        Set objFolder = objFSO.GetFolder(Subfolder.Path)
        Set colFiles = objFolder.Files
        For Each objFile in colFiles

            if not(objFSO.FileExists(replace(Subfolder.Path & "\" & objFile.Name,sourceRoot,targetRoot))) then 
              Wscript.Echo Subfolder.Path & "\" & objFile.Name

              Set objFileLog = objFSO.CreateTextFile(lastFileLog,True)
              objFileLog.Write Subfolder.Path & "\" & objFile.Name
              objFileLog.Close

              objFSO.CopyFile Subfolder.Path & "\" & objFile.Name, replace(Subfolder.Path & "\" & objFile.Name,sourceRoot,targetRoot)

            elseif replacefile = Subfolder.Path & "\" & objFile.Name then
              Wscript.Echo "Replacing ... " & Subfolder.Path & "\" & objFile.Name  
              objFSO.CopyFile Subfolder.Path & "\" & objFile.Name, replace(Subfolder.Path & "\" & objFile.Name,sourceRoot,targetRoot),true            
            else
              Wscript.Echo "Skip ... " & Subfolder.Path & "\" & objFile.Name
            end if
        Next
        ShowSubFolders Subfolder
    Next
end sub

For Folder: Try This.对于文件夹:试试这个。

Option Explicit
Dim obj,Itemcoll1,a,b
Set obj=CreateObject("Shell.Application")
Function SelectFold1(Desc)
Set SelectFold1=obj.BrowseForFolder(0,Desc,0,"C:\Users\Mohammed Sajjad\Desktop\")
End Function

Set Itemcoll1=SelectFold1("Copy: ").Items
SelectFold1("Paste: ").CopyHere Itemcoll1 'Use MoveHere if you want to move
MsgBox "Completed"

For File:对于文件:

Option Explicit
Dim objApp : Set objApp = CreateObject("Shell.Application")
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objSHL : Set objSHL = CreateObject("WScript.Shell")

'Browse for Folder
'----------------------------------------------------------
Function SelectFold()
     Dim objFolder
     Set objFolder = objApp.BrowseForFolder(0,"Select a Folder",0,0)
     If objFolder Is Nothing Then
     MsgBox "Canceled"
     WScript.Quit
     Else
     SelectFold = objFolder.Self.Path & "\"
     End If
End Function
'----------------------------------------------------------
'Browse for file
'----------------------------------------------------------
Function SelectFile()
Dim tempFolder : Set tempFolder = objFSO.GetSpecialFolder(2)
Dim tempFile : tempFile = objFSO.GetTempName() & ".hta"
Dim path : path = "HKCU\Volatile Environment\MsgResp"
 With tempFolder.CreateTextFile(tempFile)
    .Write "<input type=file name=f>" & _
     "<script>f.click();(new ActiveXObject('WScript.Shell'))" & _
     ".RegWrite('HKCU\\Volatile Environment\\MsgResp', f.value);" & _
     "close();</script>"
    .Close
 End With
 objSHL.Run tempFolder & "\" & tempFile, 0, True
 If objSHL.RegRead(path) = "" Then
  objSHL.RegDelete path
  objFSO.DeleteFile tempFolder & "\" & tempFile
  WScript.Quit
 End If
 SelectFile = objSHL.RegRead(path)
 objSHL.RegDelete path
 objFSO.DeleteFile tempFolder & "\" & tempFile
End Function
'----------------------------------------------------------
objFSO.CopyFile SelectFile, SelectFold

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM