VBA 将文件移动到新文件夹，如果文件存在于新文件夹中则重命名

Question

我正在尝试将文件从一个文件夹移动到另一个文件夹。如果文件名已经存在于新文件夹中，我需要在标题末尾使用创建日期重命名。以下是我目前所拥有的

Private Sub LetsMove_Click()

Application.ScreenUpdating = False

'Move all files from OldAddressTextBox to NewAddressTextBoxand append the created date to the name if new file title already exists.


Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object, errResult As String
Set mergeObj = CreateObject("Scripting.FileSystemObject")
 

Set dirObj = mergeObj.Getfolder(OldAddressTextBox.Text)
Set filesObj = dirObj.Files
For Each everyObj In filesObj


mergeObj.CopyFolder Source:=OldAddressTextBox.Text, Destination:=NewLocationTextBox.Text

errResult = mergeObj.Rename(mergeObj.CreationDate)

Next

MsgBox "You can find the files and subfolders from " & OldAddressTextBox.Text & " in " & NewLocationTextBox.Text


End Sub

Answer 1

请尝试下一个代码。我尝试保留您的变量名，但它们不是最合适的，以便于调试代码...

它复制新位置中旧文件夹中的所有文件，如果它们不存在则使用它们的原始名称和创建日期（格式为“dd.mm.yyy” ，可以更改），用于目标位置中的现有一个。如果没有格式化，路径中不接受分隔小时、分钟和秒的“:”字符。如果您也需要它们，可以将它们包括在内，但在格式化时更改分隔符：

Private Sub LetsMove_Click()
 Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
 Dim newName As String, oldAdressFld As String, NewLocationFld As String
 Dim strExtension As String, objCr, creationDate As String

 oldAdressFld = OldAddressTextBox.text
 NewLocationFld = NewLocationTextBox.text

 Set mergeObj = CreateObject("Scripting.FileSystemObject")
 
 Set dirObj = mergeObj.GetFolder(oldAdressFld)
 Set filesObj = dirObj.Files

 For Each everyObj In filesObj
    If Not mergeObj.FileExists(Replace(everyObj, oldAdressFld, NewLocationFld)) Then
        mergeObj.CopyFile everyObj, Replace(everyObj, oldAdressFld, NewLocationFld)
    Else
        strExtension = "." & mergeObj.GetExtensionName(everyObj)
        Set objCr = mergeObj.GetFile(everyObj)
        creationDate = Format(objCr.DateCreated, "dd.mm.yyyy")
        newName = left(everyObj, Len(everyObj) - Len(strExtension)) & "_" & creationDate & strExtension
        mergeObj.CopyFile everyObj, Replace(newName, oldAdressFld, NewLocationFld)
    End If
 Next

 MsgBox "You can find the files from " & oldAdressFld & " in " & NewLocationFld
End Sub

看了你的代码，我开始问自己是否还需要复制子文件夹。如果是，可以用类似的方法来完成，但还有一些问题需要解决...

VBA 将文件移动到新文件夹，如果文件存在于新文件夹中则重命名

VBA Moving Files to New Folder, Rename if File exists in new folder

vba

rename

move

creation