本帖最后由 flashercs 于 2025-1-6 11:31 编辑
| | | | | Set fso = CreateObject("Scripting.FileSystemObject") | | | | | | Dim keywords | | keywords = Array("张三", "李四", "王五", "牛七") | | | | | | Dim currentDir | | currentDir = fso.GetAbsolutePathName(".") | | | | | | Dim folderDate | | folderDate = Right("0" & Month(Date), 2) & Right("0" & Day(Date), 2) | | | | | | Dim pdfDate | | pdfDate = Month(Date) & "." & Day(Date) | | | | | | Dim command | | Dim pdftkPath | | pdftkPath = fso.BuildPath(currentDir, "pdftk.exe") | | Dim shell | | Set shell = CreateObject("WScript.Shell") | | | | | | | | Dim keyword,targetFolderRoot | | targetFolderRoot = currentDir & "\" & folderDate & "个人学习资料" | | If Not fso.FolderExists(targetFolderRoot) Then | | fso.CreateFolder targetFolderRoot | | End If | | For Each keyword In keywords | | | | Dim targetFolder | | targetFolder = targetFolderRoot & "\" & keyword & "的个人学习资料" | | | | | | If Not fso.FolderExists(targetFolder) Then | | fso.CreateFolder targetFolder | | End If | | | | | | command = """" & pdftkPath & """ " | | | | For Each subFolder In fso.GetFolder(currentDir).SubFolders | | If subFolder.Path <> targetFolderRoot Then | | For Each file In subFolder.Files | | If InStr(1,file.Name, keyword,vbTextCompare) > 0 And LCase(fso.GetExtensionName(file.Name)) = "pdf" Then | | command = command & """" & file.Path & """ " | | End If | | Next | | End If | | Next | | command = command & " cat output " & """" & targetFolder & "\" & keyword & "的个人学习资料" & pdfDate & ".pdf""" | | | | | | shell.Run command, 0, True | | If Err.Number <> 0 Then | | WScript.Echo "执行命令时出错: " & Err.Description & " 命令: " & command | | Err.Clear | | End If | | | | Next | | Dim result | | result = MsgBox("PDF合并完成,是否删除原文件所在的文件夹?", vbQuestion Or vbYesNo Or vbSystemModal, "提示") | | If result = 6 Then | | | | For Each subFolder In fso.GetFolder(currentDir).SubFolders | | If subFolder.Path <> targetFolderRoot Then | | subFolder.Delete True | | End If | | Next | | End IfCOPY |
|