注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

奕克

爱家人爱工作爱生活

 
 
 

日志

 
 

自动抽取批量rar文件中word文档的脚本(更新版本)  

2010-09-09 10:41:47|  分类: 技术 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |
       上学期我发过日志介绍了一个脚本程序,因为我上的《大学计算机文化二》课中学生上交的都是一个rar压缩包,里面有各种实验文件,包括实验报告,而最后我查看完内容后要将评分和评语写入实验报告,因此需要统一的把各自学生包中的实验报告抽取出来,集中批改。
       通过上学期的批改实践,我发现了上个版本中的一些错误,并进行了bug修正,修正版本如下:
0)由于脚本只能找出doc文档,所有提示符里去掉了要求输入扩展名,最好用“*实验*”找所有文件名中包含实验两字的文档,不要加具体实验号,因为有些学生可能在这次课交上次课的实验报告。当然如果你能看懂这个脚本的话,自己修改成抽取其他类型文件也是容易的。
自动抽取批量rar文件中word文档的脚本(更新版本) - wucccsk - wucccsk的博客
1)上一版本,压缩文件所在文件夹名,路径名和压缩文件名不能带有空格或在桌面,这一版本已修正。
 
2)由于脚本的内部运行机制,上一版本在压缩文件所在目录同时有其他doc文档时,会出错,这一版本提前将这些文件放进了创建doc子文件夹,然后解压出来的目标文档也在doc子文件夹里面。这样也带出了个程序的附带功能,就是能将本目录下的文档进行分类放入子目录,比如找出本文件夹下所有的名字中带“荷塘月色”的文档。
自动抽取批量rar文件中word文档的脚本(更新版本) - wucccsk - wucccsk的博客
 
3)这一版本增加了一功能,在发现有学生的压缩包里没有目标文档时,会将该压缩包复制到程序创建的notfound子目录下,便于我们事后检查,这些学生为什么没交实验报告,还是命名不规范,便于告知这些学生。
 
4)文档最后增加了如下图的统计信息
自动抽取批量rar文件中word文档的脚本(更新版本) - wucccsk - wucccsk的博客
要应对的是如下图的,恰好学生的实验练习文档名也带有“实验”两字的情况,比如上图的39个压缩文件里找到了71个目标文档显然是不对的。
自动抽取批量rar文件中word文档的脚本(更新版本) - wucccsk - wucccsk的博客
 
5)上一版本没有递归查找很深的压缩包子目录里的目标文档,这一版本做了修正。
 
6)可能一个压缩包里学生交1个以上的重名目标文档,这次对这些文档自动做了重命名,比如第二个重复文档名带“(1)”表示。
 
程序已经上传到http://e.ys168.com/?wucccsk  下的“vbs和vba脚本”目录下,双击vbs脚本即可运行,也可以新建记事本,然后将下列源代码复制到文档中,选择另存,文件类型选择“所有文件”,文件名的扩展名为VBS。希望大家用的愉快,减轻工作负担,最后附上源码清单:
 
filterstr=inputbox("请输入要解压的word文件,如 * 或者 *实验* 等",,"*实验*")
if filterstr="" then WScript.Quit
filterstr=filterstr & ".doc"
nofoundstr=""
rarcount=0
doccount=0
Set WshShell = WScript.CreateObject("WScript.Shell")
rarpath=WshShell.Regread("HKLM\Software\Microsoft\Windows\CurrentVersion\Uninstall\Winrar archiver\UninstallString")
lenstr=Instr(lcase(rarpath),"uninstall.exe")
rarpath=Left(rarpath,lenstr-1) & "unrar.exe" 
rarpath=chr(34) & rarpath & chr(34) 
Set FSO = CreateObject("Scripting.FileSystemObject")
CurrentDirectory=WshShell.CurrentDirectory
Set myFolder=FSO.GetFolder(CurrentDirectory)
Set myfiles=myFolder.Files
myfilename=mid(wscript.scriptfullname,len(CurrentDirectory)+2)
If fso.FolderExists(CurrentDirectory & "\doc") Then
   fso.DeleteFolder (CurrentDirectory & "\doc")
End If
fso.CreateFolder CurrentDirectory & "\doc"
For Each myfile in myfiles
         if Instr(myfile.name,".doc")<>0 then
                   OldName=CurrentDirectory & "\" &  myfile.name
                   if Instr(myfile.name,"实验")<>0 then
                        NewName = CurrentDirectory & "\doc\" & myfile.name 
                   else
                        If not fso.FolderExists(CurrentDirectory & "\otherdoc") Then
                             fso.CreateFolder CurrentDirectory & "\otherdoc"
                        End If    
                        NewName = CurrentDirectory & "\otherdoc\" & myfile.name 
                   end if
                   fso.movefile oldname,newname 
         end if
next
newname=""
oldname=""
For Each myfile in myfiles
        if myfile.name<>myfilename and instr(myfile.name,".rar")<>0 then
         exestr=rarpath & " e -o+ -or -r -n"& filterstr & " """& CurrentDirectory & "\" & myfile.name & """"
         Wshshell.run  exestr,0,true
         Set submyfiles=myFolder.Files
         found=false
         For Each submyfile in submyfiles
           if Instr(submyfile,".doc") then
           OldName = CurrentDirectory &"\"& submyfile.name
           tempstr=left(myfile.name,len(myfile.name)-4)
           NewName = CurrentDirectory &"\doc\"& tempstr &"-"&  submyfile.name
           fso.movefile OldName,newname
           found=true
           doccount=doccount+1
           end if
         next
           if found then rarcount=rarcount+1
           if not found then 
                if nofoundstr="" then
                     If fso.FolderExists(CurrentDirectory & "\notfound") Then
                         fso.DeleteFolder (CurrentDirectory & "\notfound")
                     End If
                     fso.CreateFolder CurrentDirectory & "\notfound"
                end if     
                fso.copyfile CurrentDirectory & "\" & myfile.name,CurrentDirectory & "\notfound\" & myfile.name
                nofoundstr=nofoundstr & " , " & myfile.name
           end if
         set submyfiles=nothing
        end if
Next
if nofoundstr<>"" then
            msgbox  nofoundstr & "中没有发现目标文档"
end if
set wshell=nothing
set fso=nothing
set myfolder=nothing
set myfiles=nothing
msgbox "从"& rarcount & "个压缩文件中找到了" & doccount &"个目标文档!"

 
 
 
  评论这张
 
阅读(83)| 评论(0)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017