可以将文章内容翻译成中文,广告屏蔽插件可能会导致该功能失效(如失效,请关闭广告屏蔽插件后再试):
问题:
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