vba 如何使用 FileSystemObject 来“复制和重命名”
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/18966991/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
How can I use the FileSystemObject to "Copy and rename"
提问by enderland
Using the FileSystemObjectin VB/VBA (or native VBA calls, I guess) how can I:
在 VB/VBA（或本机 VBA 调用，我猜）中使用FileSystemObject我如何：
- Copy folder
- Rename folder
- 复制文件夹
- 重命名文件夹
So, something like:
所以，像这样：
mFSO.CopyAndRename(targetFolder, copyDirectory, copyFolderName)
I have basically done this myself but I would much prefer a more clean method call such as the above (and the CopyFoldermethod). This seems like a lot of code and a lot of potential failure points...
我基本上自己完成了这个，但我更喜欢一个更干净的方法调用，比如上面的（和CopyFolder方法）。这似乎是很多代码和很多潜在的故障点......
'
''requires reference to Microsoft Scripting Runtime
Public Function CopyDirectory(ByVal p_copyDirectory As String, p_targetDirectory As String, Optional p_newName As String = "") As Boolean
CopyDirectory = False
Dim m_fso
Set m_fso = New FileSystemObject
Dim mFolder, mNewFolder
If Not Me.DoesPathExist(p_copyDirectory) Then
Exit Function
Else
On Error GoTo errHandler
Set mFolder = m_fso.GetFolder(p_copyDirectory)
mFolder.Copy p_targetDirectory, False
'rename if a "rename" arg is passed
If p_newName <> "" Then
If DoesPathExist(p_targetDirectory & mFolder.Name) Then
Set mNewFolder = m_fso.GetFolder(p_targetDirectory & mFolder.Name)
mNewFolder.Name = "test" & CStr(Rnd(9999))
Else
End If
End If
CopyDirectory = True
On Error GoTo 0
Exit Function
End If
errHandler:
Exit Function
End Function
回答by user2780436
There is actually a method on Scripting.FileSystemObject called CopyFolder. It can be used to do both the copy and rename in one step, as follows:
实际上在 Scripting.FileSystemObject 上有一个方法叫做 CopyFolder。它可以用于一步完成复制和重命名，如下所示：
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.copyFolder "C:\Path\to\source\folder", "C:\Path\to\destination\folder" true
I found the code here: http://vba-tutorial.com/copy-a-folder-and-all-of-its-contents/
我在这里找到了代码：http: //vba-tutorial.com/copy-a-folder-and-all-of-its-contents/
Hope this answers your question.
希望这能回答你的问题。
回答by Siddharth Rout
My Fav: SHFileOperation API
我的最爱：SHFileOperation API
This also gives you the visual presentation of Folders being moved.
这也为您提供了移动文件夹的视觉呈现。
Option Explicit
Private Declare Function SHFileOperation Lib "shell32.dll" _
Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Const FO_COPY = &H2 '~~> Copy File/Folder
Const FOF_SILENT = &H4 '~~> Silent Copy
Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAborted As Boolean
hNameMaps As Long
sProgress As String
End Type
Private Sub Sample()
Dim lresult As Long, lFlags As Long
Dim SHFileOp As SHFILEOPSTRUCT
With SHFileOp
'~~> For Copy
.wFunc = FO_COPY
.pFrom = "C:\Temp"
.pTo = "C:\Temp2\"
'~~> For Silent Copy
'.fFlags = FOF_SILENT
End With
lresult = SHFileOperation(SHFileOp)
'~~> SHFileOp.fAborted will be true if user presses cancel during operation
If lresult <> 0 Or SHFileOp.fAborted Then Exit Sub
MsgBox "Operation Complete", vbInformation, "File Operations"
End Sub
For renaming a folder, here is a one liner
对于重命名文件夹，这是一个单行
Sub Sample()
Name "C:\Temp2" As "C:\Temp3"
End Sub
回答by enderland
Posting this for reference in the future. Using syntax from this answerI fleshed out a class I'd been writing.
发布此信息以供将来参考。使用这个答案中的语法，我充实了我一直在写的一个类。
I've created a directory manager class in VBA which may be relevant to anyone coming here in the future.
我在 VBA 中创建了一个目录管理器类，这可能与将来来到这里的任何人有关。
Private m_fso As New FileSystemObject
'
''requires reference to Microsoft Scripting Runtime
Public Function CopyAndRenameDirectory(ByVal p_copyDirectory As String, p_targetDirectory As String, p_newName As String) As Boolean
'example
'p_copyDirectory = "C:\temp\myGoingToBeCopiedDir
'p_targetDirectory = "C:\Temp2"
'p_newName = "AwesomeDir"
'results:
'myGoingToBeCopiedDir --> C:\Temp2\AwesomeDir
CopyAndRenameDirectory = False
p_targetDirectory = p_targetDirectory & "\"
If Not Me.DoesPathExist(p_copyDirectory) Or Not Me.DoesPathExist(p_targetDirectory) Then
Exit Function
End If
On Error GoTo errHandler
m_fso.CopyFolder p_copyDirectory, p_targetDirectory & p_newName, True
On Error GoTo 0
Exit Function
errHandler:
If PRINT_DEBUG Then Debug.Print "Error in CopyAndRenameDirectory: " & Err.Description
Exit Function
End Function
Public Function CopyDirectory(ByVal p_copyDirectory As String, p_targetDirectory As String) As Boolean
'example
'p_copyDirectory = "C:\temp\myGoingToBeCopiedDir
'p_targetDirectory = "C:\Temp2"
'p_newName = ""
'results:
'myGoingToBeCopiedDir --> C:\Temp2\myGoingToBeCopiedDir
CopyDirectory = False
If Not Me.DoesPathExist(p_copyDirectory) Or Not Me.DoesPathExist(p_targetDirectory) Then
Exit Function
End If
p_targetDirectory = p_targetDirectory & "\"
On Error GoTo errHandler
m_fso.CopyFolder p_copyDirectory, p_targetDirectory, True
On Error GoTo 0
Exit Function
errHandler:
If PRINT_DEBUG Then Debug.Print "Error in CopyDirectory: " & Err.Description
Exit Function
End Function
Public Function CreateFolder(ByVal p_path As String) As Boolean
CreateFolder = True
If Me.DoesPathExist(p_path) Then
Exit Function
Else
On Error GoTo errHandler
m_fso.CreateFolder p_path ' could there be any error with this, like if the path is really screwed up?
Exit Function
End If
errHandler:
'MsgBox "A folder could not be created for the following path: " & path & ". Check the path name and try again."
CreateFolder = False
Exit Function
End Function
Public Function DoesPathExist(ByVal p_path As String) As Boolean
DoesPathExist = False
If m_fso.FolderExists(p_path) Then DoesPathExist = True
End Function
