实现vbs脚本以将文件夹和子文件夹中的文件名重命名为hta以显示进度条

时间：2016-08-27 22:33:02

标签： vbscript hta

＆＃13;
＆＃13; 
	Dim str
	set str = Wscript.Arguments

	str = InputBox("Enter the path of the files to be renamed as per e-ctd naming pattern")
	IF str = "" THEN Cancelled

	Set goFS = CreateObject("Scripting.FileSystemObject")

	Dim sSDir : sSDir = str

	walkDirIter goFS.GetFolder(sSDir)

	Sub walkDirIter(oDir)
	Dim dicStack : Set dicStack = CreateObject("Scripting.Dictionary")
	Dim nCur     : nCur         = dicStack.Count
	Set dicStack(nCur) = oDir
	Do Until nCur >= dicStack.Count
    Dim oElm
    For Each oElm In dicStack(nCur).Files
  
		If InStr(Lcase(oElm.Name), "apple") <> 0 Then
			sName = Replace(Lcase(oElm.Name), "apple", "a1...")
			oElm.Name = sName
		End If
		If InStr(Lcase(oElm.Name), "ball") <> 0 Then
			 sName = Replace(Lcase(oElm.Name), "ball", "b2...")
			 oElm.Name = sName
		End If
		If InStr(Lcase(oElm.Name), "cat") <> 0 Then
			 sName = Replace(Lcase(oElm.Name), "cat", "c3....")
			 oElm.Name = sName
		End If
		If InStr(Lcase(oElm.Name), "dog") <> 0 Then
			sName = Replace(Lcase(oElm.Name), "dog", "d4....")
			oElm.Name = sName
		End If
		If InStr(Lcase(oElm.Name), "elephant") <> 0 Then
			sName = Replace(Lcase(oElm.Name), "elephant", "e5...")
			oElm.Name = sName
		End If
		If InStr(Lcase(oElm.Name), "fan") <> 0 Then
			sName = Replace(Lcase(oElm.Name), "fan", "f6...")
			oElm.Name = sName
		End If
		If InStr(Lcase(oElm.Name), "guitar") <> 0 Then
			sName = Replace(Lcase(oElm.Name), "guitar", "g7...")
			oElm.Name = sName
		End If
		If InStr(Lcase(oElm.Name), "hat") <> 0 Then
			sName = Replace(Lcase(oElm.Name), "hat", "h8....")
			oElm.Name = sName
		End If
		If InStr(Lcase(oElm.Name), "ink") <> 0 Then
			sName = Replace(Lcase(oElm.Name), "ink", "i9...")
			oElm.Name = sName
		End If
		If InStr(Lcase(oElm.Name), "jet") <> 0 Then
			sName = Replace(Lcase(oElm.Name), "jet", "j10...")
			oElm.Name = sName
		End If
	Next
	
    For Each oElm In dicStack(nCur).SubFolders
	 Set dicStack(dicStack.Count) = oElm
    Next
     nCur = nCur + 1
	Loop
	
	End Sub
＆＃13;
＆＃13;
＆＃13;

我正在使用vbs script来重命名文件夹中的文件以及其中的所有子文件夹并且它对我来说正常工作（尽管它不是编写vbs脚本的最佳方式。我正在努力改进）。有时重命名文件需要花费大量时间，因为有数百个文件。所以在搜索之后我发现在hta中实现vbs脚本以获得进度条和更好的视觉效果更好。 这就像我接近它一样：

＆＃13;
＆＃13; 
<html>

<head>
  <title id="title">Rename</title>
  <HTA:APPLICATION ID="ProgressBar" APPLICATIONNAME="ProgressBar" SCROLL="no" MAXIMIZEBUTTON="no" />
  <SCRIPT Language="VBScript">
    Public x, y, MyTitle

     Sub Window_Onload
     window.resizeTo 436, 216
     y = 1
     x = 1
     MyTitle = " _ Rename"
    End Sub


     Sub Go

     Set objFSO = CreateObject("Scripting.FileSystemObject")

     objStartFolder = path.value

     Set objFolder = objFSO.GetFolder(objStartFolder)

     Set colFiles = objFolder.Files

     For Each fil in colFiles

     y = y + 1

     Next

     For Each fil in colFiles

     Progress()

     If InStr(Lcase(fil.Name), "apple") < > 0 Then
     sName = Replace(Lcase(fil.Name), "apple", "a1...")
     fil.Name = sName
     End If
     If InStr(Lcase(fil.Name), "ball") < > 0 Then
     sName = Replace(Lcase(fil.Name), "ball", "b2...")
     fil.Name = sName
     End If
     If InStr(Lcase(fil.Name), "cat") < > 0 Then
     sName = Replace(Lcase(fil.Name), "cat", "c3....")
     fil.Name = sName
     End If
     If InStr(Lcase(fil.Name), "dog") < > 0 Then
     sName = Replace(Lcase(fil.Name), "dog", "d4....")
     fil.Name = sName
     End If
     If InStr(Lcase(fil.Name), "elephant") < > 0 Then
     sName = Replace(Lcase(fil.Name), "elephant", "e5...")
     fil.Name = sName
     End If
     If InStr(Lcase(fil.Name), "fan") < > 0 Then
     sName = Replace(Lcase(fil.Name), "fan", "f6...")
     fil.Name = sName
     End If
     If InStr(Lcase(fil.Name), "guitar") < > 0 Then
     sName = Replace(Lcase(fil.Name), "guitar", "g7...")
     fil.Name = sName
     End If
     If InStr(Lcase(fil.Name), "hat") < > 0 Then
     sName = Replace(Lcase(fil.Name), "hat", "h8....")
     fil.Name = sName
     End If
     If InStr(Lcase(fil.Name), "ink") < > 0 Then
     sName = Replace(Lcase(fil.Name), "ink", "i9...")
     fil.Name = sName
     End If
     If InStr(Lcase(fil.Name), "jet") < > 0 Then
     sName = Replace(Lcase(fil.Name), "jet", "j10...")
     fil.Name = sName
     End If

     Next

     ShowSubfolders objFSO.GetFolder(path.value)

     Sub ShowSubFolders(Folder)

     For Each Subfolder in Folder.SubFolders

     Set objFolder = objFSO.GetFolder(Subfolder.Path)

     Set colFiles = objFolder.Files

     For Each fil in colFiles

     y = y + 1

     Next

     For each fil in colFiles

     Progress()

     If InStr(Lcase(fil.Name), "apple") < > 0 Then
     sName = Replace(Lcase(fil.Name), "apple", "a1...")
     fil.Name = sName
     End If
     If InStr(Lcase(fil.Name), "ball") < > 0 Then
     sName = Replace(Lcase(fil.Name), "ball", "b2...")
     fil.Name = sName
     End If
     If InStr(Lcase(fil.Name), "cat") < > 0 Then
     sName = Replace(Lcase(fil.Name), "cat", "c3....")
     fil.Name = sName
     End If
     If InStr(Lcase(fil.Name), "dog") < > 0 Then
     sName = Replace(Lcase(fil.Name), "dog", "d4....")
     fil.Name = sName
     End If
     If InStr(Lcase(fil.Name), "elephant") < > 0 Then
     sName = Replace(Lcase(fil.Name), "elephant", "e5...")
     fil.Name = sName
     End If
     If InStr(Lcase(fil.Name), "fan") < > 0 Then
     sName = Replace(Lcase(fil.Name), "fan", "f6...")
     fil.Name = sName
     End If
     If InStr(Lcase(fil.Name), "guitar") < > 0 Then
     sName = Replace(Lcase(fil.Name), "guitar", "g7...")
     fil.Name = sName
     End If
     If InStr(Lcase(fil.Name), "hat") < > 0 Then
     sName = Replace(Lcase(fil.Name), "hat", "h8....")
     fil.Name = sName
     End If
     If InStr(Lcase(fil.Name), "ink") < > 0 Then
     sName = Replace(Lcase(fil.Name), "ink", "i9...")
     fil.Name = sName
     End If
     If InStr(Lcase(fil.Name), "jet") < > 0 Then
     sName = Replace(Lcase(fil.Name), "jet", "j10...")
     fil.Name = sName
     End If

     Next

     ShowSubFolders Subfolder

     Next

     End Sub

     Sub Progress
     x = x + 1
     document.Title = FormatPercent(x / y, 0) & MyTitle
     document.all.ProgBarText.innerText = x & "/" & y
     document.all.ProgBarDone.innerText = String(x, "_")
     document.all.ProgBarToDo.innerText = String(y - x, "_") & "|"
    If x = y Then
     document.all.ProgBarToDo.innerText = ""
    MsgBox "Done"
    window.close
     End If
     End Sub
  </SCRIPT>

</head>

<body bgcolor="#D7D7D7">

  Path:
  <br>
  <input type="text" name="path">
  <br>

  <br>
  <!-- Basic buttons -->
  <input id="BtnGo" type="button" value="Go" onclick="Go">
  <br>
  <span id="ProgBarText"></span>
  <br>
  <span id="ProgBarDone" style="background-color: #3399FF"></span>
  <font color="#FFFFFF">
 <span id="ProgBarToDo"style="background-color: #C0C0C0"></span>
 </font>
</body>

</html>
＆＃13;
＆＃13;
＆＃13;

这里的问题是这个hta给出了ShowSubfolders objFSO.GetFolder(path.value)的语法问题的脚本错误，所以我通过删除SUBFOLDER部分并运行像这样的hta来尝试它：

＆＃13;
＆＃13; 
<html>

<head>
  <title id="title">Rename</title>
  <HTA:APPLICATION ID="ProgressBar" APPLICATIONNAME="ProgressBar" SCROLL="no" MAXIMIZEBUTTON="no" />
  <SCRIPT Language="VBScript">
    Public x, y, MyTitle

     Sub Window_Onload
     window.resizeTo 436, 216
     y = 0
     x = 0
     MyTitle = " _ Rename"
    End Sub


     Sub Go

     Set objFSO = CreateObject("Scripting.FileSystemObject")

     objStartFolder = path.value

     Set objFolder = objFSO.GetFolder(objStartFolder)

     Set colFiles = objFolder.Files

     For Each fil in colFiles

     y = y + 1

     Next
	 
	 
For Each fil in colFiles

Progress()
  
If InStr(Lcase(fil.Name), "apple") <> 0 Then
    sName = Replace(Lcase(fil.Name), "apple", "a1...")
    fil.Name = sName
End If
If InStr(Lcase(fil.Name), "ball") <> 0 Then
     sName = Replace(Lcase(fil.Name), "ball", "b2...")
     fil.Name = sName
End If
If InStr(Lcase(fil.Name), "cat") <> 0 Then
     sName = Replace(Lcase(fil.Name), "cat", "c3....")
     fil.Name = sName
End If
If InStr(Lcase(fil.Name), "dog") <> 0 Then
    sName = Replace(Lcase(fil.Name), "dog", "d4....")
    fil.Name = sName
End If
If InStr(Lcase(fil.Name), "elephant") <> 0 Then
    sName = Replace(Lcase(fil.Name), "elephant", "e5...")
    fil.Name = sName
End If
If InStr(Lcase(fil.Name), "fan") <> 0 Then
    sName = Replace(Lcase(fil.Name), "fan", "f6...")
    fil.Name = sName
End If
If InStr(Lcase(fil.Name), "guitar") <> 0 Then
    sName = Replace(Lcase(fil.Name), "guitar", "g7...")
    fil.Name = sName
End If
If InStr(Lcase(fil.Name), "hat") <> 0 Then
    sName = Replace(Lcase(fil.Name), "hat", "h8....")
    fil.Name = sName
End If
If InStr(Lcase(fil.Name), "ink") <> 0 Then
    sName = Replace(Lcase(fil.Name), "ink", "i9...")
    fil.Name = sName
End If
If InStr(Lcase(fil.Name), "jet") <> 0 Then
    sName = Replace(Lcase(fil.Name), "jet", "j10...")
    fil.Name = sName
End If

Next

     End Sub

     Sub Progress
     x = x + 1
     document.Title = FormatPercent(x / y, 0) & MyTitle
     document.all.ProgBarText.innerText = x & "/" & y
     document.all.ProgBarDone.innerText = String(x, "_")
     document.all.ProgBarToDo.innerText = String(y - x, "_") & "|"
    If x = y Then
     document.all.ProgBarToDo.innerText = ""
    MsgBox "Done"
    window.close
     End If
     End Sub
  </SCRIPT>

</head>

<body bgcolor="#D7D7D7">

  Path:
  <br>
  <input type="text" name="path">
  <br>

  <br>
  <!-- Basic buttons -->
  <input id="BtnGo" type="button" value="Go" onclick="Go">
  <br>
  <span id="ProgBarText"></span>
  <br>
  <span id="ProgBarDone" style="background-color: #3399FF"></span>
  <font color="#FFFFFF">
 <span id="ProgBarToDo"style="background-color: #C0C0C0"></span>
 </font>
</body>

</html>
＆＃13;
＆＃13;
＆＃13;

此代码仅在父文件夹中成功重命名所有相关文件名。但是，当hta运行时，我仍然没有看到增加的进度条和正在处理的文件号，直到结束。重命名所有文件后，它会在结尾显示进度条，如下所示：

Screenshot

我想知道：   - 如何使进度条保持可见并相应更新    而脚本正在处理文件   - 一种方法，包括父文件夹中子文件夹中的文件以及脚本重命名

新方法：

＆＃13;
＆＃13; 
<html>

<head>
  <title id="title">Rename</title>
  <HTA:APPLICATION ID="ProgressBar" APPLICATIONNAME="ProgressBar"
   SCROLL="no" MAXIMIZEBUTTON="no" />
  
   <SCRIPT Language="VBScript">
    
    Sub Window_Onload
     window.resizeTo 250, 180
    End Sub
		
	Set goFS = CreateObject("Scripting.FileSystemObject")

	Dim sSDir : sSDir = "C:\Users\my\Desktop\sections_2_3"

	walkDirIter goFS.GetFolder(sSDir)

	Sub walkDirIter(oDir)
	Dim dicStack : Set dicStack = CreateObject("Scripting.Dictionary")
	Dim nCur     : nCur         = dicStack.Count
	Set dicStack(nCur) = oDir
	Do Until nCur >= dicStack.Count
    Dim oElm
    For Each oElm In dicStack(nCur).Files
  
		If InStr(Lcase(oElm.Name), "apple") <> 0 Then
			sName = Replace(Lcase(oElm.Name), "apple", "a1...")
			oElm.Name = sName
		End If
		If InStr(Lcase(oElm.Name), "ball") <> 0 Then
			 sName = Replace(Lcase(oElm.Name), "ball", "b2...")
			 oElm.Name = sName
		End If
		If InStr(Lcase(oElm.Name), "cat") <> 0 Then
			 sName = Replace(Lcase(oElm.Name), "cat", "c3....")
			 oElm.Name = sName
		End If
		If InStr(Lcase(oElm.Name), "dog") <> 0 Then
			sName = Replace(Lcase(oElm.Name), "dog", "d4....")
			oElm.Name = sName
		End If
		If InStr(Lcase(oElm.Name), "elephant") <> 0 Then
			sName = Replace(Lcase(oElm.Name), "elephant", "e5...")
			oElm.Name = sName
		End If
		If InStr(Lcase(oElm.Name), "fan") <> 0 Then
			sName = Replace(Lcase(oElm.Name), "fan", "f6...")
			oElm.Name = sName
		End If
		If InStr(Lcase(oElm.Name), "guitar") <> 0 Then
			sName = Replace(Lcase(oElm.Name), "guitar", "g7...")
			oElm.Name = sName
		End If
		If InStr(Lcase(oElm.Name), "hat") <> 0 Then
			sName = Replace(Lcase(oElm.Name), "hat", "h8....")
			oElm.Name = sName
		End If
		If InStr(Lcase(oElm.Name), "ink") <> 0 Then
			sName = Replace(Lcase(oElm.Name), "ink", "i9...")
			oElm.Name = sName
		End If
		If InStr(Lcase(oElm.Name), "jet") <> 0 Then
			sName = Replace(Lcase(oElm.Name), "jet", "j10...")
			oElm.Name = sName
		End If
	Next
	
    For Each oElm In dicStack(nCur).SubFolders
	 Set dicStack(dicStack.Count) = oElm
    Next
     nCur = nCur + 1
	Loop
	
	End Sub

  </SCRIPT>

       
</head>

<body bgcolor="#D7D7D7">

  Path:
  <br>
  
  <input type="text" name="Path">
 
  <br>

  <br>
  <!-- Basic buttons -->
  <input id="BtnGo" type="button" value="Go" onclick="walkDirIter(oDir)">
  <br>
  
 </font>
</body>

</html>
＆＃13;
＆＃13;
＆＃13;

我试过这个New Method来跳过分别重复文件夹和子文件夹的相同代码。这种方法简单紧凑。

使用VB脚本：

＆＃13;
＆＃13; 
	Dim str
	set str = Wscript.Arguments

	str = InputBox("Enter the path of the files to be renamed as per e-ctd naming pattern")
	IF str = "" THEN Cancelled

	Set goFS = CreateObject("Scripting.FileSystemObject")

	Dim sSDir : sSDir = str

	walkDirIter goFS.GetFolder(sSDir)

	Sub walkDirIter(oDir)
	Dim dicStack : Set dicStack = CreateObject("Scripting.Dictionary")
	Dim nCur     : nCur         = dicStack.Count
	Set dicStack(nCur) = oDir
	Do Until nCur >= dicStack.Count
    Dim oElm
    For Each oElm In dicStack(nCur).Files
  
		If InStr(Lcase(oElm.Name), "apple") <> 0 Then
			sName = Replace(Lcase(oElm.Name), "apple", "a1...")
			oElm.Name = sName
		End If
		If InStr(Lcase(oElm.Name), "ball") <> 0 Then
			 sName = Replace(Lcase(oElm.Name), "ball", "b2...")
			 oElm.Name = sName
		End If
		If InStr(Lcase(oElm.Name), "cat") <> 0 Then
			 sName = Replace(Lcase(oElm.Name), "cat", "c3....")
			 oElm.Name = sName
		End If
		If InStr(Lcase(oElm.Name), "dog") <> 0 Then
			sName = Replace(Lcase(oElm.Name), "dog", "d4....")
			oElm.Name = sName
		End If
		If InStr(Lcase(oElm.Name), "elephant") <> 0 Then
			sName = Replace(Lcase(oElm.Name), "elephant", "e5...")
			oElm.Name = sName
		End If
		If InStr(Lcase(oElm.Name), "fan") <> 0 Then
			sName = Replace(Lcase(oElm.Name), "fan", "f6...")
			oElm.Name = sName
		End If
		If InStr(Lcase(oElm.Name), "guitar") <> 0 Then
			sName = Replace(Lcase(oElm.Name), "guitar", "g7...")
			oElm.Name = sName
		End If
		If InStr(Lcase(oElm.Name), "hat") <> 0 Then
			sName = Replace(Lcase(oElm.Name), "hat", "h8....")
			oElm.Name = sName
		End If
		If InStr(Lcase(oElm.Name), "ink") <> 0 Then
			sName = Replace(Lcase(oElm.Name), "ink", "i9...")
			oElm.Name = sName
		End If
		If InStr(Lcase(oElm.Name), "jet") <> 0 Then
			sName = Replace(Lcase(oElm.Name), "jet", "j10...")
			oElm.Name = sName
		End If
	Next
	
    For Each oElm In dicStack(nCur).SubFolders
	 Set dicStack(dicStack.Count) = oElm
    Next
     nCur = nCur + 1
	Loop
	
	End Sub
＆＃13;
＆＃13;
＆＃13;

0 个答案:

没有答案
相关问题
最新问题