我有一个 HTA 文件，其中包含 VBScript 和 JavaScript 中的函数。我遇到的问题是我有一个 VBScript 函数，可以将文件夹从一个位置复制到另一个位置。大多数情况下，该函数运行正常，除非存在“长文件名”问题。当我使用objFSO.CopyFolder调用来复制文件夹时，我现在所做的就是检查是否有错误，然后忽略复制该文件夹。
我希望能够做到的仍然是复制文件夹。我想出的解决方案是：将每个文件从文件夹复制到目标文件夹 - 然后如果在复制文件时出现错误，我可以重命名文件（缩短文件名）并将其复制到目标文件夹 - 并堆叠从子文件夹复制文件的功能。
我的问题是，在 vbscript 中有没有更好的方法来做到这一点？或者也许有另一种方法可以从 HTA 文件中执行此操作？（即 JavaScript 中的一些东西）
Function CopyFolders(arrFName, strTempDir)
Dim intCounter ' Used as a counter
Dim intCF ' Used as a counter
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject") ' File system object
' Loop to copy folder in 'arrFName' array to 'Temp' folder
For intCounter = 0 To UBound(arrFName)
Dim oFolder ' Object that holds the current folder
Dim oFile ' Object used in a loop for each file in a folder
Dim arrPath ' Array that holds the names of each folder in destination path
Dim strTempPath ' Object that holds the 'Temp' directory path
Dim strFileExtension ' Holds the extension for the file that is being copied
Dim strDestFileName ' Holds the detination file name
' Set default return value for the function
CopyFolders = True
' Set the folder
Set oFolder = objFSO.GetFolder(arrFName(intCounter))
' Let copy the folder to a temp location ...
' First we need to get the folder structure for destination folder
strFolderStructure = ConstructFolderStructure(oFolder)
' Check that folder structure has a value
If Len(strFolderStructure) > 0 Then
' Now lets check if requried folder already exists
If Not objFSO.FolderExists(strTempDir & strFolderStructure) Then
' Damn! it doesnt. Well we will have to create one ...
' Before we do anything, we have to get the folders in folder structure (this is so
' that we can check that each folder exists) and also get the 'Temp' folder
arrPath = Split(strFolderStructure, "\")
strTempPath = objFSO.GetFolder(strTempDir)
' Now loop to create each folder in destination folder path
For intCF = 0 To UBound(arrPath)
' Lets build the path for the folder and check if it exists
strTempPath = strTempPath & "\" & arrPath(intCF)
If Not objFSO.FolderExists(strTempPath) Then
' It doesnt exist so lets create the folder
objFSO.CreateFolder strTempPath
End If
Next
End If
' Now that we know that the folder sturcture exists in 'Temp' folder, lets loop
' through all files in the folder and copy them in the folder. We will set
' Error to 'Resume Next' so that we can catch any errors that occur
On Error Resume Next
For Each oFile In oFolder.Files
' Lets clear the error and attempt to copy the file. This way if there is an error
' copying the file, we can catch it
Err.Clear
objFSO.CopyFile objFSO.GetFile(oFolder.Path & "\" & oFile.Name).Path, objFSO.GetFolder(strTempPath).Path & "\" & oFile.Name
' Check if there was an error when attempting to copy the file
If Err.Number <> 0 Then
' Damn! there was. Ok, well lets try to shorten the file name and try copying again (this is because: mostly the reason for failure is long file name).
' Before we do that, we first have to generate short name for destination file
strDestFileName = objFSO.GetBaseName(objFSO.GetFile(oFolder.Path & "\" & oFile.Name).ShortName) & "." & _
objFSO.GetExtensionName(objFSO.GetFile(oFolder.Path & "\" & oFile.Name).Name)
' Now that we have the destination file name, lets try the copy thing again shall we!! (clearing the error again)
Err.Clear
objFSO.CopyFile oFolder.Path & "\" & objFSO.GetFile(oFolder.Path & "\" & oFile.Name).ShortName, _
objFSO.GetFolder(strTempPath).Path & "\" & strDestFileName
' Lets hope that it worked this time
If Err.Number <> 0 Then
' Alas .. no joy. Well the only thing we can do is stop copying files and clear the array item
arrFName(intCounter) = ""
' Now set the return value to false and exit loop
CopyFolders = False
Exit For
End If
End If
Next
' Lets reset error handling
On Error Goto 0
' Now we have to check for subfolder. So lets check if there are sub folders and function return value is true
If (oFolder.SubFolders.Count > 0) And (CopyFolders = True) Then
' There are subfolders. We have to capture subfolder names
Dim arrSubFolders ' Array That holds the subfolders
Dim oSubFolder ' Object to holds subfolder
' Lets loop through all subfolders and capture there names in an array
For Each oSubFolder In oFolder.SubFolders
If IsArray(arrSubFolders) Then
ReDim Preserve arrSubFolders(Ubound(arrSubFolders) + 1)
Else
ReDim arrSubFolders(1)
End If
arrSubFolders(Ubound(arrSubFolders) - 1) = oSubFolder.Path
Next
' Last item in the subfolder array will always be empty so lets clear it
ReDim Preserve arrSubFolders(Ubound(arrSubFolders) - 1)
' Now lets call the function again so that we can copy files from subfolders
If Not CopyFolders(arrSubFolders, strTempDir) Then
' It looks like there was a problem copying files in subfolders to set the return value and clear array item
arrFName(intCounter) = ""
CopyFolders = False
End If
' And now lets clear the subfolder array
Erase arrSubFolders
Set arrSubFolders = Nothing
End If
End If
' Clear object
Set oFolder = Nothing
Next
' Clear object
Set objFSO = Nothing
End Function
嗨，由于这已被标记为重复，我只是想快速解释一下我为什么开始一个新问题。首先，当我进行搜索时（很可能我的搜索不是很好），我没有找到那个帖子。但也看看它，建议的答案是更多的命令行选项，而我正在寻找 HTA 文件中的东西。话虽如此，如果我找到了那个帖子，我会在那个帖子上开始我的查询，所以我确实理解重复的标签。