I have 2 problems regarding FileDialog.
The below code is to copy a file from another folder into another. But if it couldn't locate that file, it would open the FileDialog to select the file.
Problems:
- When the FileDialog is opened, it would instead default to Documents and not the AltPath.
- Is it possible to select 2 or more files with FileDialog without resorting to loop?
Dim fso As Object
Dim ws As Worksheet
Dim targetFile As Object
Dim S_Line As Long
Dim BasePath As String
Dim AltPath As String
Dim AltPath2 As String
Dim MainPath As String
Dim NewPath As String
Dim Position As String
Set fso = CreateObject("Scripting.FileSystemObject")
Set ws = ActiveSheet
BasePath = "Z:\Test\Folder\"
AltPath = "B:\Test\Folder\"
MainPath = BasePath & "File.xlsm"
NewPath = "D:\Folder\"
S_Line = 0
Position = UCase(Trim(ws.Cells(R_Line, 8).Value2))
If Position = "OK" Then
If Right(MainPath, 1) = "\" Then
MainPath = Left(MainPath, Len(MainPath) - 1)
End If
If fso.FileExists(MainPath) = True Then
fso.CopyFile Source:=MainPath, Destination:=NewPath
Else
Do While S_Line < 2
Set targetFile = Application.FileDialog(msoFileDialogFilePicker)
With targetFile
.Title = "Select a File"
.AllowMultiSelect = True
.InitialFolderName = AltPath
If .Show <> -1 Then
MsgBox "You didn't select anything"
Exit Sub
End If
AltPath2 = .SelectedItems(1)
End With
fso.CopyFile Source:=AltPath2, Destination:=NewPath
S_Line = S_Line 1
Loop
End If
CodePudding user response:
You did not answer my clarification question and your question is not so clear. Please, test the next code. It will open the dialog in the folder you need, and copy the selected items in the folder you want. I commented the lines being strictly connected to your environment (Position
, S_Line
), since I cannot deduce which are they and how to be used:
Sub copyFileSourceDest()
Dim fso As Object
Dim ws As Worksheet
Dim AltPath2 As String
Dim MainPath As String
Dim NewPath As String
Dim Position As String
Const AltPath As String = "B:\Test\Folder\"
Const BasePath As String = "Z:\Test\Folder\"
Set fso = CreateObject("Scripting.FileSystemObject")
Set ws = ActiveSheet
MainPath = BasePath & "File.xlsm"
NewPath = ThisWorkbook.path & "\NewFold\" ' "D:\Folder\"
'Position = UCase(Trim(ws.cells(R_Line, 8).Value2))
'If Position = "OK" Then
'the following sequence looks useless, since it is a FILE path:
'If Right(MainPath, 1) = "\" Then
' MainPath = left(MainPath, Len(MainPath) - 1)
'End If
If fso.FileExists(MainPath) = True Then
fso.CopyFile Source:=MainPath, Destination:=NewPath
Else
Dim item As Variant
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Select a File"
.AllowMultiSelect = True
'.InitialFolderName = AltPath 'it does not exist in this Dialog type
.InitialFileName = AltPath
If .Show <> -1 Then
MsgBox "You didn't select anything"
Exit Sub
End If
For Each item In .SelectedItems
AltPath2 = item
fso.CopyFile Source:=AltPath2, Destination:=NewPath
Next
End With
End If
'End If
End Sub
It will simple copy (all) files you select in the Dialog
. Not understanding why necessary a loop as your code tried...