求VBS 移动包含指定关键字的文件到 按页打印 目录

cqz1314

VBS 求助 感谢

执行VBS后，弹出选择窗口，默认初始位置与VBS在同级目录，选择一个目录，针对当前目录有效，不包含子目录内容。

将文件名中包含下面关键字的文件，移动到 \按页打印 目录下，没有这个目录静默创建，最后弹出个对话框提示 “已完成文件移动”

keywordsStr = "张三,李四,王五,马八"

下面代码，保存为ANSI格式，执行即报错，求调整。

1. ' 创建文件系统对象
   
2. Set fso = CreateObject("Scripting.FileSystemObject")
   
3. ' 获取脚本所在的目录
   
4. Set scriptFolder = fso.GetParentFolderName(WScript.ScriptFullName)
   
5. ' 拼接出要移动文件的目标目录
   
6. Set targetFolder = fso.BuildPath(scriptFolder, "按页打印")
   
7. 
   
8. ' 如果目标目录不存在，则创建它
   
9. If Not fso.FolderExists(targetFolder) Then
   
10.     fso.CreateFolder targetFolder
    
11. End If
    
12. 
    
13. ' 定义关键字
    
14. keywordsStr = "张三,李四,王五,马八"
    
15. keywords = Split(keywordsStr, ",")
    
16. 
    
17. ' 遍历脚本所在目录中的文件
    
18. Set scriptFolderObj = fso.GetFolder(scriptFolder)
    
19. For Each file In scriptFolderObj.Files
    
20.     ' 获取文件名
    
21.     fileName = fso.GetFileName(file.Path)
    
22.     ' 检查文件名是否包含关键字
    
23.     For Each keyword In keywords
    
24.         If InStr(fileName, keyword) > 0 Then
    
25.             ' 移动文件到目标目录
    
26.             fso.MoveFile file.Path, fso.BuildPath(targetFolder, fileName)
    
27.             Exit For
    
28.         End If
    
29.     Next
    
30. Next

复制代码

czjt1234

目测没发现错误，报啥错了？错误提示是啥
win10需要另存为ANSi编码

ppll2030

第4和第6行的set 去掉试试。

aloha20200628

回复 1# cqz1314

给一个纯P版本，以下代码存为 test.bat 运行...

1. 
   
2. @echo off &setlocal &set/p "d=从资源管理器拖入包含被移动文件的目录[直接回车默认为 %cd%]："
   
3. if not defined d (set "d=%cd%") else set "d=%d:"=%"
   
4. cd /d "%d%" &md "按页打印" 2>nul
   
5. set "kw=*张三* *李四* *王五* *马八*"
   
6. (for /f "delims=" %%F in ('dir /b/a-d %kw%') do move /y "%%F" "%d%\按页打印") 2>nul
   
7. pause&exit/b
   

复制代码

cqz1314

回复 4# aloha20200628


    感谢   但测试报错  提示

脚本:\A工作区\[随手工具]错题本\B4按页打印人员文件调整.vbs
行:1
字符:1
错误:无效字符
代码:800A0408
源:Microsoft VBScript编译器错误

VBS存放路径　　　D:\A工作区\【随手工具】错题本\2025010785307个人顺序测试_语文3课
上级目录中有　文件夹名有　【】   拖拽的文件夹名中包含 “_”
要移动的文件名中有   3501张三1.7的错题本_参考答案  包含 “_”  “.”
要整理的文件类型 或WORD 或PDF

拜托  帮忙 修改 谢谢

cqz1314

回复 3# ppll2030


    测试可以 但是要把VBS移动到工作目录才行  能不能让VBS 在一个固定的位置，我选择目录后执行

谢谢

cqz1314

回复 2# czjt1234
辛苦了

脚本:\A工作区\[随手工具]错题本\B4按页打印人员文件调整.vbs
行:41
字符:错误:
缺少对象:'[string: "D:\A工作区\[随手工具]错题本"]'
代码:800A01A8
源:Microsoft VBScript运行时错误

aloha20200628

回复 5# cqz1314

4楼的代码须存为 test.bat 文件运行，这是一个100%的批处理脚本，不是 vbs 脚本  ...

czjt1234

1. key = "张三,李四,王五,马八"
   
2. 
   
3. Set oShell = CreateObject("Shell.Application")
   
4. Set oFSO = CreateObject("Scripting.FileSystemObject")
   
5. s = oFSO.GetParentFolderName(WScript.ScriptFullName)
   
6. s = oShell.BrowseForFolder(0, "", &H10, s).Self.Path
   
7. t = oFSO.BuildPath(s, "按页打印")
   
8. If Not oFSO.FolderExists(t) Then oFSO.CreateFolder t
   
9. key = Split(key, ",")
   
10. For Each file In oFSO.GetFolder(s).Files
    
11.     fileName = oFSO.GetFileName(file.Path)
    
12.     For Each keyword In key
    
13.         If InStr(fileName, keyword) > 0 Then
    
14.             oFSO.MoveFile file.Path, oFSO.BuildPath(t, fileName)
    
15.             Exit For
    
16.         End If
    
17.     Next
    
18. Next

复制代码

ppll2030

回复 6# cqz1314

执行VBS后，弹出选择窗口，默认初始位置与VBS在同级目录，选择一个目录，针对当前目录有效，不包含子目录内容。
生成的 “按页打印” 文件夹与VBS脚本同级。

修改以下两处：应该符合上面的要求了。
1、在16行中插入一下打开选择文件夹窗口代码：

1. Set Shell = CreateObject("Shell.Application")
   
2. Set objFolder = Shell.BrowseForFolder(0, "选择文件夹", 0, scriptFolder)
   
3. If Not objFolder Is Nothing Then
   
4.     selectedFolder = objFolder.Self.Path
   
5. End If

复制代码

2、第18行把scriptFolder修改为选择的文件夹selectedFolder ，也可以直接复制下方代码替换

1. Set scriptFolderObj = fso.GetFolder(selectedFolder)

复制代码