如何使用 VBScript 将目录中的文件重命名为文件夹中所有文件的文件夹名称？

Question

我有大量跨越近二十年的图像文件，其中主题由目录名称标识，并且大多数照片本身都有一个通用名称，但其中一些有更具体的名称。 我正在编写一个脚本，将目录名添加到特定目录中所有文件的文件名中。好吧，我至少在努力。 自从我使用 VBScript 以来已经有几年了，我似乎很生疏。 我在语法格式方面面临挑战。

当我有 Option Explicit（在第 6 行）时，它会给出第 6 行第 1 个字符的错误，错误：预期语句，代码：800A0400（在我的共享代码中，由于添加了文件行的开头，所以它是第 7 行）

如果我将其注释掉，我会在导入语句而不是第 3 行，字符 1，错误：类型不匹配：'导入'，代码：800A000D（在我的共享代码中，它将是第 4 行，因为添加了文件行的开头）

我花了几个小时在谷歌上搜索可能的原因，但无济于事，所以我向社区寻求帮助，以正确设置此脚本的格式。

对于完成此任务的更好脚本方法的任何评论也将不胜感激。

我将放入文件的全部代码，因为我不知道它的哪一部分是相关方面。

在代码中，目前设置为只为每个文件创建一个消息框作为测试措施，以确保变量具有我认为的值。 用于重命名文件的注释掉的代码是真正的预期目的。 但是，我坚持文件第一部分的正确格式。 通常，我使用以下命令从命令行执行此操作：cscript.exe c:\MyTools ddDir2FileName.vbs

我通过 Windows 资源管理器启动它，以获取带有行号的更具体的错误代码。

为了清楚起见，我添加了文件开头和文件结尾注释。

' ####### Beginning of File
' Renames all files in a directory prepending the directory name to the file name

Imports System
Imports System.IO

Option Explicit

Dim WshShell, strOldFull, strNewFull, strFullPath, strCurDir
Dim strCurrentName, strNewName, strMessage, dir, fileObj, fs, fo

' Get the current directory
Set WshShell = CreateObject("WScript.Shell")
strFullPath = WshShell.CurrentDirectory

'Get folder properties to get just the name without path
Set fs=Server.CreateObject("Scripting.FileSystemObject")
Set fo=fs.GetFolder(strFullPath)

strCurDir = fo.Name

'Iterate through the directory
set dir = DirectoryInfo(strFullPath)

For Each fileObj In dir.GetFiles()
  strCurrentName = fileObj.Name
  strNewName = strCurDir & " - " & strCurrentName

  ' For testing purposes to make sure everything is as expected
  ' Creates a message box for each file instead of actually renaming it
  strMessage = "Old Name: " & strCurrentName & chr(13) & chr(10) & "New Name: " & strNewName 
  MsgBox strMessage

  ' Renaming the file
  ' strOldFull =  fs.BuildPath(CurrentDirectory, strCurrentName)
  ' strNewFull = fs.BuildPath(CurrentDirectory, strNewName)
  ' My.Computer.FileSystem.RenameFile(strOldFull, strNewFull)

Next

WshShell = Nothing
fo = Nothing
fs = Nothing

' ### End of File

期望文件“C:\Pictures\Trip to Nice\DCM001.jpg”将重命名为“C:\Pictures\Trip to Nice\Trip to Nice - DCM001.jpg”并且目录中的所有文件脚本运行的地方将被类似地重命名。 好吧，更准确地说，当前格式化的输出将产生一个消息框，上面写着“旧名称：C:\Pictures\Trip to Nice\DCM001.jpg 新名称：C:\Pictures\Trip to Nice\Trip to Nice - DCM001.jpg”，并且将为目录中的所有文件生成一个消息框。是的，我只会在包含 3 个文件的测试目录中运行消息框版本。我讨厌得到 50,000 个消息框，哈哈。

目前没有输出，因为 Import Statement 或 Option Explicit 的格式问题，或者可能是我遗漏或有误的其他语法部分。

感谢您的宝贵时间以及任何人能够提供的帮助。这是我第一次在社区发帖，但我很感激所提供的答案。通常，我会发现我的问题已经得到解答，但我对这个感到难过......

Answer 1

好吧，通过大量的试验和错误，我想出了一种方法来完成我没有使用系统的任务，从而避免了我之前收到的错误。 我想发布最终脚本，以防万一有人感兴趣。

' Renames all files in a directory prepending the directory name to the file name
Option Explicit

Dim WshShell, strOldFull, strFullPath, strCurDir, lastSlash
Dim strCurrentName, strNewName, strMessage, fileObj, fileSpec, fs, fo, ff

' Get the current directory
Set WshShell = CreateObject("WScript.Shell")
strFullPath = WshShell.CurrentDirectory

'Get folder object 
Set fs = CreateObject("Scripting.FileSystemObject")
Set fo = fs.GetFolder(strFullPath)
set ff = fo.Files

'Get just the folder name
lastSlash = inStrRev(strFullPath, "\")
strCurDir = right(strFullPath, len(strFullPath) - lastSlash )


'Iterate through the directory
For Each fileObj in ff
  strCurrentName = fileObj.Name
  strNewName = strCurDir & " - " & strCurrentName

  ' For testing purposes to make sure everything is as expected
  ' Creates a message box for each file instead of actually renaming it
  ' strMessage = "Old Name: " & strCurrentName & chr(13) & chr(10) & "New Name: " & strNewName 
  ' MsgBox strMessage

  ' Renaming the file
  strOldFull =  strFullPath & "\" & strCurrentName
  set fileSpec = fs.GetFile(strOldFull)
  fileSpec.Name = strNewName

Next

Answer 2

' Declare variables
Dim objFSO, objParentFolder, objFolder, objFile

' Set the parent directory to be processed
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objParentFolder = objFSO.GetFolder("C:\path\to\parent\directory")

' Function to process the subfolders
Sub ProcessSubFolders(folder)
    ' Loop through all files in the folder
    For Each objFile In folder.Files
        ' Get the current file name
        strFileName = objFile.Name
        ' Get the folder name
        strFolderName = folder.Name
        ' Build the new file name
        strNewFileName = strFolderName & "_" & strFileName
        ' Rename the file
        objFile.Name = strNewFileName
    Next

    ' Loop through all subfolders
    For Each objFolder In folder.SubFolders
        ' Recursively call the function for the subfolder
        ProcessSubFolders(objFolder)
    Next
End Sub

' Call the function to process the top-level folder
ProcessSubFolders(objParentFolder)

' Clean up
Set objFile = Nothing
Set objParentFolder = Nothing
Set objFSO = Nothing