Код VBA Чтобы предложить любому пользователю выбрать исходную папку и целевую папку

Question

Я пытаюсь повторно отредактировать приведенный ниже код VBA (отлично работает), который будет предлагать пользователю диалоговое окно для выбора папки «Исходный» и другое диалоговое окно для выбора целевой папки.Буду признателен за любую помощь.

Код ниже, прекрасно работает в моем собственном каталоге.Но было бы здорово, если бы другие пользователи могли выбирать папки по своему усмотрению.

Option Explicit

**SRC_FOLDER = GetFolder()
DEST_FOLDER = GetFolder()**

Dim Rng As Range, fPath, fName
Dim maxRows As Long, maxCols As Long, r As Long, c As Long

Set Rng = Selection
maxRows = Rng.Rows.Count
maxCols = Rng.Columns.Count

'assuming the first row in ther selection is the headers...
'  otherwise, start at 1
For r = 2 To maxRows
    fPath = DEST_FOLDER '<<set starting point
    For c = 2 To maxCols
        fPath = fPath & "\" & Rng.Cells(r, c) '<<build next level
        If Len(Dir(fPath, vbDirectory)) = 0 Then MkDir fPath
On Error Resume Next
    Next c
    'create file name
    fName = Right("0000000000" & Rng.Cells(r, 1).Value, 10) & ".pdf"
    'copy to fpath
    FileCopy SRC_FOLDER & fName, fPath & "\" & fName
Next r

End Function

Этот код работает отлично, благодаря @Tim Williams. Я просто хочу, чтобы этот макрос был более удобным для пользователядругие пользователи

Answer 1

Рассмотрим:

Function GetFolder() As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    Set fldr = Nothing
End Function

Я не писал этот код.

Он был получен из:

Озгрид

и от Mr Excel

РЕДАКТИРОВАТЬ № 1:

Заменить:

 Const DEST_FOLDER = "C:\Users\Manzurfa\Desktop\Macros"

with:

 DEST_FOLDER = GetFolder()

и т. д.

(если вы хотите сгенерировать полную спецификацию файла, убедитесь, что обратная косая черта между путем и именем файла корректно управляется.)