Выберите предыдущий файл в папке и скопируйте его в новый

Question

Мне нужно сделать следующее:

• Разрешить пользователю выбирать любое количество файлов в любом формате и копировать их в новую папку.
• Создать место назначения папка, если она не существует. В этом случае имя папки должно быть задано содержимым ячеек C2 и C3 (диапазон ("C2"). Value & Range ("C3"). Текст & "\").

Private Sub CommandButton4_Click()

Dim strDirname As String
Dim strDefpath As String
Dim strPathname As String
Dim strFilename As String
Dim FSO
Dim sFile As FileDialog
Dim sSFolder As String
Dim sDFolder As String

strDirname = Range("C2").Value & Range("C3").Text

MkDir strDefpath & "\" & strDirname
strPathname = strDefpath & "\" & strDirname & "\" & strFilename

Set sFile = Application.FileDialog(msoFileDialogOpen)

sDFolder = strDirname & "\"

Set FSO = CreateObject("Scripting.FileSystemObject")
Set FSO = New FileSystemObject
With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = False
    If Not .Show Then Exit Sub
    Set xFolder = FSO.GetFolder(.SelectedItems(1))
    For Each xFile In xFolder.Files
        On Error Resume Next
        xRow = Application.Match(xFile.Name, Range("A:A"), 0)
        On Error GoTo 0
    Next
End With

End Sub

Я знаю, что ошибка здесь ...

Set xFolder = FSO.GetFolder(.SelectedItems(1))

... потому что я прошу его получить файл, а не папку.

Answer 1

Ваш опубликованный код очень мало похож на то, что вы просите Q, я проигнорировал его.

Этот код соответствует описанию. Возможно, вам придется изменить некоторые детали, чтобы полностью соответствовать вашим потребностям

Sub Demo()
    Dim FilePicker As FileDialog
    Dim DefaultPath As String
    Dim DestinationFolderName As String
    Dim SelectedFile As Variant
    Dim DestinationFolder As Folder
    Dim FSO As FileSystemObject

    DefaultPath = "C:\Data" ' <~~ update to suit, or get it from somewhere else

    ' Validate Default Path
    If Right$(DefaultPath, 1) <> Application.PathSeparator Then
        DefaultPath = DefaultPath & Application.PathSeparator
    End If
    If Not FSO.FolderExists(DefaultPath) Then Exit Sub

    ' Get Destination Folder, add trailing \ if required
    DestinationFolderName = Range("C2").Value & Range("C3").Value
    If Right$(DestinationFolderName, 1) <> Application.PathSeparator Then
        DestinationFolderName = DestinationFolderName & Application.PathSeparator
    End If

    Set FSO = New FileSystemObject

    ' Get reference to Destination folder, create it if required
    If FSO.FolderExists(DefaultPath & DestinationFolderName) Then
        Set DestinationFolder = FSO.GetFolder(DefaultPath & DestinationFolderName)
    Else
        Set DestinationFolder = FSO.CreateFolder(DefaultPath & DestinationFolderName)
    End If

    ' File Selection Dialog
    Set FilePicker = Application.FileDialog(msoFileDialogFilePicker)
    With FilePicker
        .AllowMultiSelect = True ' allow user to select multiple files
        .InitialFileName = DefaultPath ' set initial folder for dialog
        If .Show = False Then Exit Sub ' check if user cancels
        For Each SelectedFile In .SelectedItems ' loop over selected files
            If SelectedFile Like DefaultPath & "*" Then 'Optional: disallow browsing higher than default folder
                FSO.CopyFile SelectedFile, DefaultPath & DestinationFolderName, True  ' Copy file, overwrite is it exists
            End If
        Next
    End With
End Sub

Answer 2

Мне не очень понятно, что вы пытаетесь сделать, но, если вы собираетесь выбрать папку, вы должны использовать ее

    Application.FileDialog (msoFileDialogFolderPicker)

вместо

    Application.FileDialog (msoFileDialogFilePicker)