Home > Software design >  Initial Folder and Multiple Select (FileDialog)
Initial Folder and Multiple Select (FileDialog)

Time:02-22

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:

  1. When the FileDialog is opened, it would instead default to Documents and not the AltPath.
  2. 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...

  • Related