[问题求助] VBS如何将拖拽执行的文件改为指定路径执行？

makimaki00

请问这个代码怎么将拖拽执行改为指定路径执行，在哪里进行修改呢？

​Dim​ ​ws,fs,rootFolder,message,​ ​_ 
 ​        ​cLog,LogName,​ ​_ 
 ​        ​EmptyFolder,TempFolder 
 ​Set​ ​osh​ ​=​ ​CreateObject(​"WScript.Shell"​) 
 ​set​ ​fso​ ​=​ ​CreateObject(​"Scripting.FileSystemObject"​) 
 ​cLog​ ​=​ ​True​ ​'是否生成日志文件 
 ​LogName​ ​=​ ​WScript.ScriptFullName​ ​&​ ​"_"​ ​&​ ​Replace(Replace(FormatDateTime(Now(),vbGeneralDate),​"/"​,​"-"​),​":"​,​"-"​)​ ​&​ ​".log"​ ​'日志名称 
 ​EmptyFolder​ ​=​ ​"(_Empty)"​ ​'空文件夹存放点 
 ​TempFolder​ ​=​ ​"(_Temp)"​ ​'转移用临时存放点 
 ​
 ​If​ ​WScript.Arguments.Count<​1​ ​Then 
 ​        ​WScript.Echo​ ​"请把需要缩减的父文件夹拖到本脚本上运行（既使用参数方式提供路径）" 
 ​        ​WScript.Quit 
 ​ElseIf​ ​LCase(Right(WScript.FullName,​11​))​ ​=​ ​"wscript.exe"​ ​Then 
 ​    ​osh.run​ ​"cmd /c cscript.exe //nologo """​ ​&​ ​WScript.ScriptFullName​ ​&​ ​""" """​ ​&​ ​WScript.Arguments(​0​)​ ​&​ ​"""" 
 ​    ​WScript.quit 
 ​End​ ​If 
 
 ​'End If 
 
 
 ​'搜寻文件夹迭代函数 
 ​Function​ ​FindChildren(FolderPath) 
 ​        ​set​ ​iFolder​ ​=​ ​fso.GetFolder(FolderPath)​     ​'获取文件夹 
 ​        ​set​ ​iSubFolders​ ​=​ ​iFolder.SubFolders​    ​'获取子目录集合 
 ​        ​set​ ​iFiles​ ​=​ ​iFolder.Files​              ​'获取文件集合 
 ​        ​If​ ​iFiles.Count=​ ​0​ ​And​ ​iSubFolders.count​ ​=​ ​1​ ​Then​ ​'如果只有一个文件夹 
 ​                ​For​ ​each​ ​Cfolder​ ​in​ ​iSubFolders​ ​'迭代调用本函数 
 ​                        ​FindChildren​ ​=​ ​FindChildren(Cfolder) 
 ​                        ​Exit​ ​For 
 ​                ​Next 
 ​        ​ElseIf​ ​iFiles.Count>​ ​0​ ​Or​ ​iSubFolders.count​ ​>​ ​1​ ​Then​ ​'如果有文件或者两个及以上文件夹则为最内层 
 ​                ​FindChildren​ ​=​ ​FolderPath 
 ​        ​Else​ ​'什么都没有的空文件夹 
 ​                ​FindChildren​ ​=​ ​"empty" 
 ​        ​End​ ​if 
 ​End​ ​Function 
  
 ​'是否符合正则表达式 
 ​Function​ ​RegExpTest(strng,​ ​patrn)​  
 ​        ​Dim​ ​regEx​      ​' 创建变量。 
 ​        ​Set​ ​regEx​ ​=​ ​New​ ​RegExp​         ​' 创建正则表达式。 
 ​        ​regEx.Pattern​ ​=​ ​patrn​         ​' 设置模式。 
 ​        ​regEx.IgnoreCase​ ​=​ ​True​         ​' 设置是否区分大小写，True为不区分。 
 ​        ​regEx.Global​ ​=​ ​True​         ​' 设置全程匹配。 
 ​        ​RegExpTest​ ​=​ ​regEx.Test(strng)​   ​' 执行搜索。 
 ​        ​Set​ ​regEx​ ​=​ ​Nothing 
 ​End​ ​Function 
 
  
 ​If​ ​WScript.Arguments.Count<​1​ ​Then 
 ​        ​rootFolder​ ​=​ ​osh.CurrentDirectory​ ​'当前程序所在目录 
 ​Else 
 ​        ​rootFolder​ ​=​ ​WScript.Arguments(​0​)​ ​'将第一个参数存入 
 ​End​ ​IfCOPY

makimaki00

回复 2# czjt1234
感谢大佬

czjt1234

​Dim​ ​ws,fs,rootFolder,message,​ ​_
​        ​cLog,LogName,​ ​_
​        ​EmptyFolder,TempFolder
​Set​ ​osh​ ​=​ ​CreateObject(​"WScript.Shell"​)
​set​ ​fso​ ​=​ ​CreateObject(​"Scripting.FileSystemObject"​)
​cLog​ ​=​ ​True​ ​'是否生成日志文件
​LogName​ ​=​ ​WScript.ScriptFullName​ ​&​ ​"_"​ ​&​ ​Replace(Replace(FormatDateTime(Now(),vbGeneralDate),​"/"​,​"-"​),​":"​,​"-"​)​ ​&​ ​".log"​ ​'日志名称
​EmptyFolder​ ​=​ ​"(_Empty)"​ ​'空文件夹存放点
​TempFolder​ ​=​ ​"(_Temp)"​ ​'转移用临时存放点
​
s = "d:\指定路径文件夹"
​If​ ​WScript.Arguments.Count > 0​ ​Then s = ​WScript.Arguments(​0​)
If​ ​LCase(Right(WScript.FullName,​11​))​ ​=​ ​"wscript.exe"​ ​Then
​    ​osh.run​ ​"cmd /c cscript.exe //nologo """​ ​&​ ​WScript.ScriptFullName​ ​&​ ​""" """​ ​&​ s​ ​&​ ​""""
​    ​WScript.quit
​End​ ​If
​'End If

​'搜寻文件夹迭代函数
​Function​ ​FindChildren(FolderPath)
​        ​set​ ​iFolder​ ​=​ ​fso.GetFolder(FolderPath)​     ​'获取文件夹
​        ​set​ ​iSubFolders​ ​=​ ​iFolder.SubFolders​    ​'获取子目录集合
​        ​set​ ​iFiles​ ​=​ ​iFolder.Files​              ​'获取文件集合
​        ​If​ ​iFiles.Count=​ ​0​ ​And​ ​iSubFolders.count​ ​=​ ​1​ ​Then​ ​'如果只有一个文件夹
​                ​For​ ​each​ ​Cfolder​ ​in​ ​iSubFolders​ ​'迭代调用本函数
​                        ​FindChildren​ ​=​ ​FindChildren(Cfolder)
​                        ​Exit​ ​For
​                ​Next
​        ​ElseIf​ ​iFiles.Count>​ ​0​ ​Or​ ​iSubFolders.count​ ​>​ ​1​ ​Then​ ​'如果有文件或者两个及以上文件夹则为最内层
​                ​FindChildren​ ​=​ ​FolderPath
​        ​Else​ ​'什么都没有的空文件夹
​                ​FindChildren​ ​=​ ​"empty"
​        ​End​ ​if
​End​ ​Function
  
​'是否符合正则表达式
​Function​ ​RegExpTest(strng,​ ​patrn)​  
​        ​Dim​ ​regEx​      ​' 创建变量。
​        ​Set​ ​regEx​ ​=​ ​New​ ​RegExp​         ​' 创建正则表达式。
​        ​regEx.Pattern​ ​=​ ​patrn​         ​' 设置模式。
​        ​regEx.IgnoreCase​ ​=​ ​True​         ​' 设置是否区分大小写，True为不区分。
​        ​regEx.Global​ ​=​ ​True​         ​' 设置全程匹配。
​        ​RegExpTest​ ​=​ ​regEx.Test(strng)​   ​' 执行搜索。
​        ​Set​ ​regEx​ ​=​ ​Nothing
​End​ ​Function
  
​If​ ​WScript.Arguments.Count<​1​ ​Then
​        ​rootFolder​ ​=​ ​osh.CurrentDirectory​ ​'当前程序所在目录
​Else
​        ​rootFolder​ ​=​ ​WScript.Arguments(​0​)​ ​'将第一个参数存入
​End​ ​If


既可指定文件夹，也可拖放