Copying files from a selected filepath to a filepath mentioned in a worksheet's cell

**subbby** · 09-10-2012, 03:19 PM

What I am trying to do is :

Have the VBA pgm ask the user the folder where the files are located
and have them copied to a file path mentioned in a cell

Tried the following code:

Private Sub Copy_Folder_click()

    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String
    
    Worksheets("Sheet1").Range("A5") = cmbx_typeofmanual.Value
    
        Dim xRow As Long
    Dim xDirect$, xFname$, InitialFoldr$


    InitialFoldr$ = "G:\"    '<<< Startup folder to begin searching from


    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = Application.DefaultFilePath & "\"
        .Title = "Please select a folder to list Files from"
        .InitialFileName = InitialFoldr$
        .Show
        If .SelectedItems.Count <> 0 Then
            xDirect$ = .SelectedItems(1) & "\"
            End If
            
    End With
    
FromPath = xDirect$


    
    ToPath = Worksheets("Sheet1").Range("A24")
'    Worksheets("Sheet1").Range("A24") = is a value i got by using --> CONCATENATE(C, ":\", A1, "\", A3, "\", A4, "\", A5, "\", C10, "\").. which is on my sheet as C:\Falk\Gear_Box\Manuals\Instructions (ALL FOLDERS PRESENT)
   FileCopy "FromPath", "ToPath"
   
  
    If FSO.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
    End If


    'FSO.CopyFolder Source:=FromPath, Destination:=ToPath
    MsgBox "You can find the files and subfolders from " & FromPath & " in " & ToPath





End Sub

Courtesy : Above code is a modified one found on http://www.rondebruin.nl/folder.htm

Any help is much appreciated. thanks

cross posted
http://www.ozgrid.com/forum/showthre...446#post627446

**subbby** · 09-10-2012, 03:59 PM

SOLVED IT :

modified the code and had replaced a few lines with

Dim MySource01
   Dim MyDestination01
   Dim fn
   On Error Resume Next   ' if file is open it will not be copied
   MySource01 = Sheets("Sheet1").Range("A30")
   MyDestination01 = Sheets("Sheet1").Range("A24")
   
   ' ensure closing \ is there
   If Right(MySource01, 1) <> "\" Then MySource01 = MySource01 & "\"
   If Right(MyDestination01, 1) <> "\" Then MyDestination01 = MyDestination01 & "\"
   
   
   fn = Dir(MySource01 & "*.*")
   
   Do While Not fn = ""
   
   FileCopy MySource01 & fn, MyDestination01 & fn
   
   fn = Dir()
   Loop

Courtesy : http://en.allexperts.com/q/Excel-105...-Using-VBA.htm