批处理之家 - Powered by Discuz! Board

标题: 求VBS 移动包含指定关键字的文件到按页打印目录 [打印本页]

作者: cqz1314 时间: 2025-1-12 14:39 标题: 求VBS 移动包含指定关键字的文件到按页打印目录

VBS 求助感谢

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

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

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

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

' 创建文件系统对象
Set fso = CreateObject("Scripting.FileSystemObject")
' 获取脚本所在的目录
Set scriptFolder = fso.GetParentFolderName(WScript.ScriptFullName)
' 拼接出要移动文件的目标目录
Set targetFolder = fso.BuildPath(scriptFolder, "按页打印")

' 如果目标目录不存在，则创建它
If Not fso.FolderExists(targetFolder) Then
    fso.CreateFolder targetFolder
End If

' 定义关键字
keywordsStr = "张三,李四,王五,马八"
keywords = Split(keywordsStr, ",")

' 遍历脚本所在目录中的文件
Set scriptFolderObj = fso.GetFolder(scriptFolder)
For Each file In scriptFolderObj.Files
    ' 获取文件名
    fileName = fso.GetFileName(file.Path)
    ' 检查文件名是否包含关键字
    For Each keyword In keywords
        If InStr(fileName, keyword) > 0 Then
            ' 移动文件到目标目录
            fso.MoveFile file.Path, fso.BuildPath(targetFolder, fileName)
            Exit For
        End If
    Next
Next
复制代码

作者: czjt1234 时间: 2025-1-12 15:12

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

作者: ppll2030 时间: 2025-1-12 16:05

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

作者: aloha20200628 时间: 2025-1-12 16:19

本帖最后由 aloha20200628 于 2025-1-12 16:33 编辑

回复 1# cqz1314

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

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

作者: cqz1314 时间: 2025-1-12 17:39

本帖最后由 cqz1314 于 2025-1-12 17:44 编辑

回复 4# aloha20200628

感谢但测试报错提示

脚本

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

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

拜托帮忙修改谢谢

作者: cqz1314 时间: 2025-1-12 17:48

回复 3# ppll2030

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

谢谢

作者: cqz1314 时间: 2025-1-12 17:49

回复 2# czjt1234
辛苦了

脚本

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

作者: aloha20200628 时间: 2025-1-12 17:59

回复 5# cqz1314

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

...

作者: czjt1234 时间: 2025-1-12 21:55

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

Set oShell = CreateObject("Shell.Application")
Set oFSO = CreateObject("Scripting.FileSystemObject")
s = oFSO.GetParentFolderName(WScript.ScriptFullName)
s = oShell.BrowseForFolder(0, "", &H10, s).Self.Path
t = oFSO.BuildPath(s, "按页打印")
If Not oFSO.FolderExists(t) Then oFSO.CreateFolder t
key = Split(key, ",")
For Each file In oFSO.GetFolder(s).Files
    fileName = oFSO.GetFileName(file.Path)
    For Each keyword In key
        If InStr(fileName, keyword) > 0 Then
            oFSO.MoveFile file.Path, oFSO.BuildPath(t, fileName)
            Exit For
        End If
    Next
Next
复制代码

作者: ppll2030 时间: 2025-1-12 22:03

回复 6# cqz1314

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

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

Set Shell = CreateObject("Shell.Application")
Set objFolder = Shell.BrowseForFolder(0, "选择文件夹", 0, scriptFolder)
If Not objFolder Is Nothing Then
    selectedFolder = objFolder.Self.Path
End If
复制代码

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

Set scriptFolderObj = fso.GetFolder(selectedFolder)
复制代码

欢迎光临批处理之家 (http://bbs.bathome.net/)