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

时间:2011-11-18 00:24:03

标签: vba filedialog

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

因为我希望用户知道目录中还有其他文件(所以他们不选择已存在的另一个文件的名称),我的想法是打开一个列出目录内容的FileDialog框,这样用户就可以使用FileDialog框的本机重命名功能。然后我将循环该FileDialog,直到源文件和目标文件名不再相同。

以下是一些示例代码:

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

但是当我重命名file2并单击“确定”时,我收到错误:

Run-time error '53': File not found

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

我不确定这里发生了什么 - 文件重命名后对象引用会丢失吗?是否有更简单的方法让用户从显示目标目录中所有文件的对话框重命名?我还想为文件提供一个默认的新名称,但我看不出我是如何使用这种方法做的。

编辑:此时我正在研究使用列表框创建一个UserForm,该列表框将填充相关的文件名,以及一个输入框,其中包含用于输入新名称的默认值。但是,一旦文件被重命名,仍然不确定如何保持对象引用。

2 个答案:

答案 0 :(得分:1)

以下是使用Application.FileDialog返回用户选择的文件名的示例。也许它会有所帮助,因为它证明了获得用户提供的价值。

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

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

编辑二:基于评论,我拼凑了一个似乎完全符合你想要的样本。当然,除非您想要将“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

答案 1 :(得分:0)

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

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

希望这会有所帮助。在错误恢复接下来不是最好的事情,但在这个例子中,如果变量没有文件

,则停止错误