[系统相关] 批处理能否自动提取优盘上的word文档？

water0

1假设优盘的盘符是G
2优盘一旦插进去自动将里面的所有word文档复制到一个文件夹里面
3没有优盘插进去时什么也不做

tangqingfu

谢谢分享，收藏！

yedu

。。。学习一下

water0

[attach]3318[/attach]有时候会出现这样的情况，程序可以运行

broly

'//VBS复制U盘Doc文件 @CODE BY Broly
'//声明：此VBS由Broly制作,代码仅作学习研究之用。使用前请三思而行，产生不良后果均与本人无关！
Const DocPath="D:\DocPath\" '此处为你放DOC文件的文件夹，运行前请创建好
Dim fso,Disks 
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 
      Udisk=Disk.DriveLetter & ":\"
      U=True
    End if
  Next
  If U=True Then
    CopyDocs(Udisk)
  Else
    If n=1 Then 
      Msgbox "没有发现U盘或者U盘没有插好!",vbOkOnly,"提示"
    End if
  End If
  WScript.Sleep 30000  '每30秒循环一次
Loop
Sub CopyDocs(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)="doc" Then
      fso.CopyFile File.Path,DocPath,True '设置为True，表示如果文件存在则覆盖
    End if
  Next
  For Each subfolder In subfolders
      CopyDocs(subfolder.path) '递归查找子目录
  Next
End Sub
复制代码

water0

能否在不插优盘时只提醒一次

wuhengsi

我改天写帮你写个代码吧
现在因为没有时间。。。。
QQ316891946  请楼主提醒。。。。。

wuhengsi

很简单嘛何必这么复杂。。。。

broly

怪不得你运行错误

Const DocPath="D:\DocPath\"1'此处为你放DOC文件的文件夹，运行前请创建好
复制代码

“1”是什么来的？
我的意思是把

D:\DocPath\
复制代码

这个改为你要保存的路径
比如你要保存在文件夹 d:\123\ 下面
那么这一句就是

Const DocPath="D:\123\"   '此处为你放DOC文件的文件夹，运行前请创建好
复制代码

water0

代码我改成这样

'//VBS复制U盘Doc文件 @CODE BY Broly
'//声明：此VBS由Broly制作,代码仅作学习研究之用。使用前请三思而行，产生不良后果均与本人无关！

Const DocPath="D:\DocPath\"1'此处为你放DOC文件的文件夹，运行前请创建好
Dim fso,Disks 
Set fso = CreateObject("Scripting.FileSystemObject")
Do
  Set Disks = fso.Drives 
  For Each Disk In Disks 
    If Disk.IsReady And Disk.DriveType = 1 Then 
      Udisk=Disk.DriveLetter & ":\"
      U=True
    End if
  Next
  If U=True Then
    CopyDocs(Udisk)
  Else
    Msgbox "没有发现U盘或者U盘没有插好!",vbOkOnly,"提示"
  End If
  WScript.Sleep 30000  '每30秒循环一次
Loop

Sub CopyDocs(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)="doc" Then
      fso.CopyFile File.Path,DocPath,True '设置为True，表示如果文件存在则覆盖
    End if
  Next
  For Each subfolder In subfolders
      CopyDocs(subfolder.path) '递归查找子目录
  Next
End Sub
复制代码

water0

第二个代码后缀名是vbs时[attach]3304[/attach]
后缀名bat时没反应

broly

试过，可以。怎么不行了？
你用哪一个代码？

water0

你试过吗，怎么在我的电脑上不行啊

broly

下面这个是运行一次的代码

'//VBS复制U盘Doc文件 @CODE BY Broly
'//声明：此VBS由Broly制作,代码仅作学习研究之用。使用前请三思而行，产生不良后果均与本人无关！
Const DocPath="D:\DocPath\" '此处为你放DOC文件的文件夹，运行前请创建好
Dim fso,Disks 
Set fso = CreateObject("Scripting.FileSystemObject") 
Set Disks = fso.Drives 
For Each Disk In Disks 
  If Disk.IsReady And Disk.DriveType = 1 Then 
    Udisk=Disk.DriveLetter & ":\"
    U=True
  End if
Next
If U=True Then
  CopyDocs(Udisk)
Else
  Msgbox "没有发现U盘或者U盘没有插好!",vbOkOnly,"提示"
  WScript.Quit
End If
WScript.Quit

Sub CopyDocs(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)="doc" Then
      fso.CopyFile File.Path,DocPath,True '设置为True，表示如果文件存在则覆盖
    End if
  Next
  For Each subfolder In subfolders
      CopyDocs(subfolder.path) '递归查找子目录
  Next
End Sub
复制代码

下面这个是无限循环的代码（即监控状态）。

 
'//VBS复制U盘Doc文件 @CODE BY Broly
'//声明：此VBS由Broly制作,代码仅作学习研究之用。使用前请三思而行，产生不良后果均与本人无关！
 
Const DocPath="D:\DocPath\" '此处为你放DOC文件的文件夹，运行前请创建好
Dim fso,Disks 
Set fso = CreateObject("Scripting.FileSystemObject")
Do
  Set Disks = fso.Drives 
  For Each Disk In Disks 
    If Disk.IsReady And Disk.DriveType = 1 Then 
      Udisk=Disk.DriveLetter & ":\"
      U=True
    End if
  Next
  If U=True Then
    CopyDocs(Udisk)
  Else
    Msgbox "没有发现U盘或者U盘没有插好!",vbOkOnly,"提示"
  End If
  WScript.Sleep 30000  '每30秒循环一次
Loop

Sub CopyDocs(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)="doc" Then
      fso.CopyFile File.Path,DocPath,True '设置为True，表示如果文件存在则覆盖
    End if
  Next
  For Each subfolder In subfolders
      CopyDocs(subfolder.path) '递归查找子目录
  Next
End Sub
复制代码

broly

LZ要求在一种监控状态，一有U盘插入就有反应？用批处理或者VBS，这样是很耗用CPU的。