使用 Application.FileDialog 在 VBA 中重命名文件

using Application.FileDialog to rename a file in VBA

提问by sigil

Using VBA. My script moves a file into a directory. If that filename already exists in the target directory, I want the user to be prompted to rename the source file (the one that's being moved) before the move is executed.

使用 VBA。我的脚本将文件移动到目录中。如果该文件名已存在于目标目录中，我希望在执行移动之前提示用户重命名源文件（正在移动的文件）。

Because I want the user to know what other files are in the directory already (so they don't choose the name of another file that's already there), my idea is to open a FileDialog box listing the contents of the directory, so that the user can use the FileDialog box's native renaming capability. Then I'll loop that FileDialog until the source file and target file names are no longer the same.

因为我希望用户知道目录中已经存在哪些其他文件（因此他们不会选择已经存在的另一个文件的名称），所以我的想法是打开一个列出目录内容的 FileDialog 框，以便用户可以使用 FileDialog 框的本机重命名功能。然后我将循环那个 FileDialog 直到源文件和目标文件名不再相同。

Here's some sample code:

这是一些示例代码：

Sub testMoveFile()

Dim fso As FileSystemObject
Dim file1 As File
Dim file2 As File
Dim dialog As FileDialog

Set fso = New FileSystemObject
fso.CreateFolder "c:\dir1"
fso.CreateFolder "c:\dir2"
fso.CreateTextFile "c:\dir1\test.txt"
fso.CreateTextFile "c:\dir2\test.txt"
Set file1 = fso.GetFile("c:\dir1\test.txt")
Set file2 = fso.GetFile("c:\dir2\test.txt")

Set dialog = Application.FileDialog(msoFileDialogOpen)

While file1.Name = file2.Name
    dialog.InitialFileName = fso.GetParentFolderName(file2.Path)
    If dialog.Show = 0 Then
        Exit Sub
    End If
Wend

file1.Move "c:\dir2\" & file1.Name

End Sub

But when I rename file2 and click 'OK', I get an error:

但是当我重命名 file2 并单击“确定”时，出现错误：

Run-time error '53': File not found

and then going into the debugger shows that the value of file2.name is <File not found>.

然后进入调试器显示 file2.name 的值为<File not found>.

I'm not sure what's happening here--is the object reference being lost once the file's renamed? Is there an easier way to let the user rename from a dialog that shows all files in the target directory? I'd also like to provide a default new name for the file, but I can't see how I'd do that using this method.

我不确定这里发生了什么——文件重命名后对象引用是否丢失？有没有更简单的方法让用户从显示目标目录中所有文件的对话框中重命名？我还想为文件提供一个默认的新名称，但我不知道如何使用这种方法来做到这一点。

edit: at this point I'm looking into making a UserForm with a listbox that gets populated w/ the relevant filenames, and an input box with a default value for entering the new name. Still not sure how to hold onto the object reference once the file gets renamed, though.

编辑：在这一点上，我正在考虑制作一个带有列表框的用户窗体，该列表框填充了相关文件名，以及一个带有用于输入新名称的默认值的输入框。但是，仍然不确定如何在文件重命名后保留对象引用。

回答by Ken White

Here's a sample of using Application.FileDialogto return a filename that the user selected. Maybe it will help, as it demonstrates getting the value the user provided.

这是Application.FileDialog用于返回用户选择的文件名的示例。也许它会有所帮助，因为它展示了获得用户提供的价值。

EDIT: Modified to be a "Save As" dialog instead of "File Open" dialog.

编辑：修改为“另存为”对话框而不是“文件打开”对话框。

Sub TestFileDialog()
  Dim Dlg As FileDialog
  Set Dlg = Application.FileDialog(msoFileDialogSaveAs)

  Dlg.InitialFileName = "D:\Temp\Testing.txt"  ' Set suggested name for user
                                               ' This could be your "File2"

  If Dlg.Show = -1 Then
    Dim s As String
    s = Dlg.SelectedItems.Item(1)  ` Note that this is for single-selections!
  Else
    s = "No selection"
  End If
  MsgBox s
End Sub

Edit two: Based on comments, I cobbled together a sample that appears to do exactly what you want. You'll need to modify the variable assignments, of course, unless you're wanting to copy the same file from "D:\Temp" to "D:\Temp\Backup" over and over. :)

编辑二：根据评论，我拼凑了一个示例，它似乎完全符合您的要求。当然，您需要修改变量分配，除非您想一遍又一遍地将同一文件从“D:\Temp”复制到“D:\Temp\Backup”。:)

Sub TestFileMove()
  Dim fso As FileSystemObject

  Dim SourceFolder As String
  Dim DestFolder As String
  Dim SourceFile As String
  Dim DestFile As String

  Set fso = New FileSystemObject
  SourceFolder = "D:\Temp\"
  DestFolder = "D:\Temp\Backup\"
  SourceFile = "test.txt"
  Set InFile = fso.GetFile(SourceFolder & SourceFile)
  DestFile = DestFolder & SourceFile
  If fso.FileExists(DestFile) Then
    Dim Dlg As FileDialog
    Set Dlg = Application.FileDialog(msoFileDialogSaveAs)
    Dlg.InitialFileName = DestFile
    Do While True
      If Dlg.Show = 0 Then
        Exit Sub
      End If
      DestFile = Dlg.Item

      If Not fso.FileExists(DestFile) Then
        Exit Do
      End If
    Loop
  End If

  InFile.Move DestFile
End Sub

回答by Sico

Here's some really quick code that I knocked up but basically looks at it from a different angle. You could put a combobox on a userform and get it to list the items as the user types. Not pretty, but it's a start for you to make more robust. I have hardcoded the directory c:\ here, but this could come from a text box

这是我编写的一些非常快速的代码，但基本上是从不同的角度来看它的。您可以在用户表单上放置一个组合框，并让它在用户键入时列出项目。不漂亮，但它是你变得更健壮的开始。我在这里对目录 c:\ 进行了硬编码，但这可能来自文本框

Private Sub ComboBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, 
       ByVal Shift As Integer)

Dim varListing() As Variant
Dim strFilename As String
Dim strFilePart As String
Dim intFiles As Integer

ComboBox1.MatchEntry = fmMatchEntryNone

strFilePart = ComboBox1.Value

strFilename = Dir("C:\" & strFilePart & "*.*", vbDirectory)

Do While strFilename <> ""
    intFiles = intFiles + 1
    ReDim Preserve varListing(1 To intFiles)
    varListing(intFiles) = strFilename
    strFilename = Dir()
Loop

On Error Resume Next
ComboBox1.List() = varListing
On Error GoTo 0

ComboBox1.DropDown

End Sub

Hope this helps. On error resume next is not the best thing to do but in this example stops it erroring if the variant has no files

希望这可以帮助。在错误恢复下一步不是最好的事情，但在这个例子中，如果变体没有文件，它会停止错误