1

I am trying to re-edit the below VBA code (Works perfectly) that would prompt the user a dialog box to select the Source folder and another dialog box to choose their choice of target folder. Any help would be appreciated.

The code below, works wonderfully within my own directory. But it would be great to make it flexible for other users to choose their own choice of folders.

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

This code works perfectly, thanks to @Tim Williams I just want this macro to be more user friendly with other users

Pᴇʜ
  • 56,719
  • 10
  • 49
  • 73
fahadmanzur
  • 51
  • 6
  • 2
    Possible duplicate of [VBA EXCEL To Prompt User Response to Select Folder and Return the Path as String Variable](https://stackoverflow.com/questions/26392482/vba-excel-to-prompt-user-response-to-select-folder-and-return-the-path-as-string) – BruceWayne Jan 31 '19 at 16:41

1 Answers1

-1

Consider:

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

I did not write this code.

It was derived from:

Ozgrid

and from Mr Excel

EDIT#1:

So replace:

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

with:

 DEST_FOLDER = GetFolder()

etc.

(if you want to generate a full filespec, make sure the back-slash between the path and filename is correctly managed.)

Gary's Student
  • 95,722
  • 10
  • 59
  • 99
  • Thank you. I'm a new bee to VBA. how would you suggest I inculcate your code to replace the Source and destination scripts in my code? Once again, Appreciate your help – fahadmanzur Jan 31 '19 at 17:16
  • When I do it for SRC_FOLDER = GetFolder(), it throws an pop up error quoting "variable not defined". How do I proceed? – fahadmanzur Jan 31 '19 at 18:40
  • This question should be closed as a duplicate, and you're a gold badge holder in Excel and Excel-VBA. – Ken White Jan 31 '19 at 18:50
  • Apologies @ken white, I wasn't able to source the duplicate codes to make my code work. Hence requested for help. Looking forward to your response. – fahadmanzur Jan 31 '19 at 19:25