using Application.FileDialog to rename a file in VBA

匿名 (未验证) 提交于 2019-12-03 01:41:02

问题:

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.

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.

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:

Run-time error '53': File not found

and then going into the debugger shows that the value of file2.name is <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.

回答1:

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

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. :)

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


回答2:

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

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



标签
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!