文章/答案/技术大牛

发布

社区首页 >问答首页 >VB脚本复制文件和进度条

问VB脚本复制文件和进度条
EN

Stack Overflow用户

提问于 2012-08-07 00:47:21

回答 2查看 12.5K关注 0票数 1

我将文件从源复制到目标的代码运行良好，我尝试做的是仅复制较新的文件或具有不同名称的文件。文件的名称示例abc1.txt，在接下来的一周中，这将被替换为abc2.txt的源文件夹。这里是VB脚本代码。

`

Dim intFCount, FSO, strSrcFolder, strDestFolder, strSource, FC, i, intPercentComplete

    i = 0
    intFCount = 0
    intPercentComplete = 0
    Set FSO = CreateObject("Scripting.FileSystemObject")

    strSrcFolder = "\\server\DATA\Production\RUM\"
    strDestFolder = "E:\DATA\Production\test\"

    set strSource = FSO.GetFolder(strSrcFolder)
    set FC = strSource.Files

    for each file in FC
        intFCount = intFCount + 1
    Next

    For Each file in FC
        FSO.CopyFile file, strDestFolder
        i = i + 1
    Next
    2.  I was able to find some progress bar vbs or hta script but struggling to incorporate my copy script to display the progress.  
    Here is the progress bar .hta script found on the net
    <html>
    <head>
    <title id="title">ProgressBar 2.1</title>
    <HTA:APPLICATION ID="porgbar" APPLICATIONNAME="progbartest">
    <script language="vbscript">

    Public x,y, MyTitle, iTimerID, KeepGoing

    Sub Window_Onload
    MyTitle = document.Title
    id("ProgBarToDo").innerText = String(80, "_") & "|"  
    window.ResizeTo 720, 200       
    x=0       
    y=35     
    End Sub

    Sub Go
    '---FOR TEST ONLY---
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set oof = fso.CreateTextFile("testpb.vbs", True)
    oof.WriteLine "wscript.sleep WScript.Arguments(0)"  
    oof.Close
    Set WshShell = CreateObject("WScript.Shell")
    '----END OF TEST ONLY----

    Progress(1)
    Do Until x=y
    x=x+1
    WshShell.Run "testpb.vbs 250",1,True  '----FOR TEST ONLY
    If KeepGoing = False Or window.screenTop > 10000 Then 
    Exit Do
    End If
    Loop
    Progress(0)
    End Sub

    Sub Progress(v)
    Select Case v
    Case 0  
    window.clearInterval(iTimerID)  
    iTimerID =""             
    id("BtnGo").disabled = False       
    id("BtnCancel").disabled = True    
    id("BtnExit").disabled = False     
    Progress(2)            
    MsgBox "Operation finished.",,MyTitle

    Case 1  
    iTimerID = window.setInterval("Progress(2)", 500)    
    id("BtnGo").disabled = True        
    id("BtnCancel").disabled = False   
    id("BtnExit").disabled = True      
    KeepGoing = True
    Progress(2)         

    Case 2  
    document.Title = FormatPercent(x/y, 0) & MyTitle  
    id("ProgBarText").innerText = x & "/" & y  
    d = Round( x / (y/80)  ,0)   
    id("ProgBarDone").innerText = String(d, "_")  
    If d<80 Then   
    id("ProgBarToDo").innerText = String(80-d, "_") & "|"  
    Else     
    id("ProgBarToDo").innerText = "|"  
    End If

    End Select
    End Sub

    Function id(o)
    Set id = document.getElementById(o)
    End Function

    Sub Help
    MsgBox "This is an example of progressbar in HTA written by Fredledingue.",,MyTitle
    End Sub

    </script>
    </head>
    <body bgcolor="GreenYellow">

    <input id="BtnGo"     type="button" value="Go"     onclick="Go">
    <input id="BtnCancel" type="button" value="Cancel" onclick="KeepGoing=False" disabled="True">
    <input id="BtnExit"   type="button" value="Exit"   onclick="window.close">
    <input id="BtnHelp"   type="button" value="Help"   onclick="Help">
    <br>

    Done: <span id="ProgBarText">?</span><br>
    <span id="ProgBarDone" style="background-color:blue"></span>
    <span id="ProgBarToDo" style="background-color:silver"></span>

    </body>
    </html>
    `

任何帮助都是非常感谢的。非常感谢，党卫军

在msdn上也发现了一些比较代码，但如果没有从服务器复制abc2.txt到本地驱动器，我需要检查文件abc1.txt是否存在于服务器上。以下是代码

enter code here Option Explicit  
Dim objFSO, wshShell  
Set objFSO   = CreateObject("Scripting.FileSystemObject")     
Set wshShell = CreateObject("Wscript.Shell")  
'----------------------------------------------------------------------------------------------------------------------------  
On Error Resume Next 
   ProcessScript  
   If Err.Number <> 0 Then 
      Wscript.Quit  
   End If 
On Error Goto 0  
'----------------------------------------------------------------------------------------------------------------------------  
'Name       : ProcessScript -> Primary Function that controls all other script processing.  
'Parameters : None          ->  
'Return     : None          ->  
'----------------------------------------------------------------------------------------------------------------------------  
Function ProcessScript  
   Dim localFile, serverFile  
   Dim localFileVersion, serverFileVersion  
   localFile  = "C:\rsccc2k\login\login.exe" 
   serverFile = "\\destiny\Install\RSCCC\login.exe" 
   If objFSO.FileExists(localFile) Then 
      If Not GetFileVersion(localFile, localFileVersion) Then 
         Exit Function 
      End If 
      If objFSO.FileExists(serverFile) Then 
         If Not GetFileVersion(serverFile, serverFileVersion) Then 
            Exit Function 
         End If 
      End If 
      If StrComp(localFileVersion, serverFileVersion, vbTextCompare) <> 0 Then 
         On Error Resume Next 
            wshShell.Run "\\destiny\Install\RSCCC\RSCCCInstall.bat", 0, true  
         On Error Goto 0  
      End If 
   End If 
End Function 

'----------------------------------------------------------------------------------------------------------------------------  
'Name       : GetFileVersion -> Enumerates the version number of a file.  
'Parameters : fileSpec       -> Input  : Folder path and file name for the file to enumerate the version number from.  
'           : fileVersion    -> Output : The file version number of input parameter "fileSpec".  
'Return     : GetFileVersion -> Returns False or True and the version number of the file.  
'----------------------------------------------------------------------------------------------------------------------------  
Function GetFileVersion(fileSpec, fileVersion)  
   GetFileVersion = False 
   On Error Resume Next 
      fileVersion = objFSO.GetFileVersion(fileSpec)  
      If Len(fileVersion) = 0 Or Err.Number <> 0 Then 
         Exit Function 
      End If 
   On Error Goto 0  
   GetFileVersion = True 
End Function

vbscript

回答 2

Stack Overflow用户

发布于 2014-04-20 10:00:53

您也可以使用等待栏尝试此脚本

(脚本由Sree翻译)

Option Explicit
Dim sSrc,sDest,MyCmd,Temp,Title,MsgTitle,MsgWaiting,Copyright,oExec,ws,LogTmpFile,LogFile,MyExcludeFile,Settings
Copyright = "[ XcopyScript © Hackoo Crackoo © 2014 ]"
Set ws = CreateObject("WScript.Shell")
Temp = ws.ExpandEnvironmentStrings("%Temp%")
sSrc = "C:\Downloads"
sDest = "C:\XCopytest"
LogTmpFile = "MyTmpXCopyLog.txt"
LogFile = "MyXCopyLog.txt"
Settings = " /D /Y /E /F"
MyCmd = "XCopy" & " " & DblQuote(sSrc) & " " & DblQuote(sDest) & " " & Settings &" > " & LogTmpFile &_
" & cmd /U /C Type " & LogTmpFile & " > " & LogFile & " & Del " & LogTmpFile & ""
Title = "Copy backup " & Copyright
MsgWaiting = "Copy backup : <font color=Yellow>" & DblQuote(sSrc) & " to " & DblQuote(sDest) & " </font>  . . . ."
Call CreateProgressBar(Title,MsgWaiting)
Call LaunchProgressBar()
Call Pause(2)
Call Run(MyCmd,0)
Call CloseProgressBar()
ws.run LogFile
'****************************************************************************************************
 Function Run(StrCmd,Console)
    Dim ws,MyCmd,Result
    Set ws = CreateObject("wscript.Shell")
'A value of 0 to hide the MS-DOS console
    If Console = 0 Then
        MyCmd = "CMD /C " & StrCmd & " "
        Result = ws.run(MyCmd,Console,True)
        If Result = 0 Then
            MsgBox "Success"
        Else
            MsgBox "An unknown error has occurred!",16,"An unknown error has occurred!"
        End If
    End If
'A value of 1 to show the MS-DOS console
    If Console = 1 Then
        MyCmd = "CMD /K " & StrCmd & " "
        Result = ws.run(MyCmd,Console,False)
        If Result = 0 Then
            MsgBox "Success"
        Else
            MsgBox "An unknown error has occurred!",16,"An unknown error has occurred!"
        End If
    End If
    Run = Result
End Function
'****************************************************************************************************
Sub CreateProgressBar(Title,MsgWaiting)
    Dim ws,fso,f,f2,ts,ts2,Ligne,i,fread,LireTout,NbLigneTotal,Temp,PathOutPutHTML,fhta,oExec
    Set ws = CreateObject("wscript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Temp = WS.ExpandEnvironmentStrings("%Temp%")
    PathOutPutHTML = Temp & "\Barre.hta"
    Set fhta = fso.OpenTextFile(PathOutPutHTML,2,True)
    fhta.WriteLine "<HTML>"
    fhta.WriteLine "<HEAD>"
    fhta.WriteLine "<Title>  " & Title & "</Title>"
    fhta.WriteLine "<HTA:APPLICATION"
    fhta.WriteLine "ICON = ""magnify.exe"" "
    fhta.WriteLine "BORDER=""THIN"" "
    fhta.WriteLine "INNERBORDER=""NO"" "
    fhta.WriteLine "MAXIMIZEBUTTON=""NO"" "
    fhta.WriteLine "MINIMIZEBUTTON=""NO"" "
    fhta.WriteLine "SCROLL=""NO"" "
    fhta.WriteLine "SYSMENU=""NO"" "
    fhta.WriteLine "SELECTION=""NO"" "
    fhta.WriteLine "SINGLEINSTANCE=""YES"">"
    fhta.WriteLine "</HEAD>"
    fhta.WriteLine "<BODY text=""white""><CENTER><DIV><SPAN ID=""ProgressBar""></SPAN>"
    fhta.WriteLine "<span><marquee DIRECTION=""LEFT"" SCROLLAMOUNT=""3"" BEHAVIOR=ALTERNATE><font face=""Comic sans MS"">" & MsgWaiting &"</font></marquee></span></DIV></CENTER></BODY></HTML>"
    fhta.WriteLine "<SCRIPT LANGUAGE=""VBScript""> "
    fhta.WriteLine "Set ws = CreateObject(""wscript.Shell"")"
    fhta.WriteLine "Temp = WS.ExpandEnvironmentStrings(""%Temp%"")"
    fhta.WriteLine "Sub window_onload()"
    fhta.WriteLine "    CenterWindow 500,90"
    fhta.WriteLine "    Self.document.bgColor = ""DarkOrange"" "
    fhta.WriteLine " End Sub"
    fhta.WriteLine " Sub CenterWindow(x,y)"
    fhta.WriteLine "    Dim iLeft,itop"
    fhta.WriteLine "    window.resizeTo x,y"
    fhta.WriteLine "    iLeft = window.screen.availWidth/2 - x/2"
    fhta.WriteLine "    itop = window.screen.availHeight/2 - y/2"
    fhta.WriteLine "    window.moveTo ileft,itop"
    fhta.WriteLine "End Sub"
    fhta.WriteLine "</script>"
    fhta.close
End Sub
'**********************************************************************************************
Sub LaunchProgressBar()
    Set oExec = Ws.Exec("mshta.exe " & Temp & "\Barre.hta")
End Sub
'**********************************************************************************************
Sub CloseProgressBar()
    oExec.Terminate
End Sub
'**********************************************************************************************
Sub Pause(NSeconds)
    WScript.Sleep(NSeconds*1000)
End Sub  
'**********************************************************************************************
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************

票数 1

Stack Overflow用户

发布于 2012-08-07 19:56:54

我只在vbs中有这样一个例程，但Tomalak是对的，运行外部命令会更容易和更快

Set oShell = WScript.CreateObject("WScript.Shell")
source = "c:\temp"
target = "c:\temp2"
parameters = "/ds"
oShell.Run "XCOPY " & parameters & " """ & source & """ """ & target & """"

票数 0

页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持

原文链接：

https://stackoverflow.com/questions/11832500

复制

相似问题

问VB脚本复制文件和进度条
EN

回答 2

Stack Overflow用户

Stack Overflow用户

社区

活动

圈层

关于

腾讯云开发者

热门产品

热门推荐

更多推荐

问VB脚本复制文件和进度条EN

回答 2

Stack Overflow用户

Stack Overflow用户

社区

活动

圈层

关于

腾讯云开发者

热门产品

热门推荐

更多推荐

问VB脚本复制文件和进度条
EN