我正在嘗試重命名在主檔案夾中找到的檔案，然后將重命名的檔案放在與要復制的檔案相同的目錄中。這是我原來的檔案夾結構：
Main Folder
|
|____file1.txt
|____file2.txt
|____file1.txt
我現在想在主檔案夾下創建一個名為“重命名”的檔案夾，并將重命名的檔案放在那里。成功執行代碼后，新的檔案夾結構應如下所示：
Main Folder
|
|____Renamed
| |
| |____renamed-file1.txt
| |____renamed-file2.txt
| |____renamed-file3.txt
|
|____file1.txt
|____file2.txt
|____file1.txt
但是，在我到目前為止的代碼中，我無法在主檔案夾下創建“重命名”檔案夾，因為我收到了Run-time error '5': Invalid procedure call or argument似乎出現在行的錯誤訊息fso.CopyFolder sItem, strPath2。你能幫我用重命名的檔案夾和檔案創建檔案夾結構嗎？
這是我的代碼：
Sub RenameFile()
Dim fldr As FileDialog
Dim sItem As String
Dim strPath As String
Dim strPath1 As String
Dim strPath2 As String
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
Dim z As String
Dim s As String
Dim V As Integer
Dim TotalRow As Integer
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = Application.DefaultFilePath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
TotalRow = ActiveSheet.UsedRange.Rows.Count
NextCode:
strPath = sItem
strPath2 = fso.BuildPath(sItem, "Renamed")
' Create the folder "Renamed"
fso.CopyFolder sItem, strPath2
For V = 1 To TotalRow
' Get value of each row in columns 1 start at row 2
z = Cells(V 1, 1).Value
' Get value of each row in columns 2 start at row 2
s = Cells(V 1, 2).Value
Dim sOldPathName As String
sOldPathName = fso.BuildPath(strPath2, z)
sNewPathName = fso.BuildPath(strPath2, s)
Name sOldPathName As sNewPathName
On Error Resume Next
Name sOldPathName As s
Next V
MsgBox "Congratulations! You have successfully renamed all the files"
End Sub
uj5u.com熱心網友回復：
Dir使用和復制和重命名檔案FileCopy
- 使用FileCopy更快、更簡單、更直接：一次復制和重命名。
- 這是一個簡化的示例，可讓您熟悉
Dir和FileCopy。在您的情況下，您將“Dir”列中的每個名稱，A如果檔案名的長度大于 0（確認檔案存在），您將“FileCopy 將源路徑復制到目標路徑（使用列中的名稱B） '。
Sub RenameFiles()
' Source
Const sFilePattern As String = "*.*"
Dim sInitPath As String: sInitPath = Application.DefaultFilePath & "\"
' Destination
Const dSubFolderName As String = "Renamed"
Const dPrefix As String = "renamed-"
Dim sFolderPath As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select a Folder"
.InitialFileName = sInitPath
If .Show <> -1 Then
MsgBox "You canceled.", vbExclamation
Exit Sub
End If
sFolderPath = .SelectedItems(1) & "\"
End With
Dim dFolderPath As String: dFolderPath = sFolderPath & dSubFolderName & "\"
If Len(Dir(dFolderPath, vbDirectory)) = 0 Then MkDir dFolderPath
Dim sFileName As String: sFileName = Dir(sFolderPath & sFilePattern)
If Len(sFileName) = 0 Then
MsgBox "No files found.", vbExclamation
Exit Sub
End If
On Error GoTo FileCopyError
Do Until Len(sFileName) = 0
FileCopy sFolderPath & sFileName, dFolderPath & dPrefix & sFileName
sFileName = Dir
Loop
On Error GoTo 0
MsgBox "Congratulations! You have successfully renamed all the files.", _
vbInformation
Exit Sub
FileCopyError:
Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description _
& vbLf & "Could not copy '" & sFileName & "'."
Resume Next
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/shujuku/484820.html