Macro for Coping and pasting the files from folder

[santhoshbes]

Hi,
I would need a help in macro for coping all the Files with extension “.xls” from the main folder and paste it in the specified folder. There would be a sub folder in the Main folder. Macro should copy and paste the files from sub folders also.
Please help me !!
Thanks !!

 

[apo]

Hi..

Try this..

Private Sub CommandButton1_Click()
   Dim x, fldr As FileDialog, SelFold As String, i As Long, targFolder As String
   targFolder = "C:\Test"

    'Select Folder that contains your .xls files
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        If .Show <> -1 Then Exit Sub
        SelFold = .SelectedItems(1)
    End With

    'All .xls* files in Selected FolderPath including Sub folders are put into an array
    x = Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & SelFold & "\*.xls"" /s/b").stdout.readall, vbCrLf)

    'Loop through that array
    For i = LBound(x) To UBound(x) - 1
    
    'Copy file(s) to targFolder
            CreateObject("shell.application").Namespace((targFolder)).CopyHere (x(i)) & "\"
    Next i
End Sub

 

[santhoshbes]

Hi,

Thanks for your reply !!!

I found the macro is not working in the Selected path for Mapped network drive. ( I have mapped sharepoint with my system).

Pls help me in macro with predefined sharepoint address, Hence the macro would take all the files from sharepoint adress. the sharepoint address is fixed one

 

[ParamRay]

Option Explicit

Sub runcopyfiles()

    'call copyfiles procedure
    'with source folder...
    
    copyfiles "C:\Users\jsmith\Documents\originals"
    
    'notification that
    'macro is finished...
    
    MsgBox _
        Prompt:="Finished", _
        Buttons:=vbInformation

End Sub

Sub copyfiles(sfold As String)

    'for source folder:
    Dim sfile As String
    Dim spath As String
    
    'for destination folder:
    Dim dfold As String
    Dim dpath As String
    
    'For subfolders of
    'source folder:
    Dim fso As Object
    Dim gf As Object
    Dim sf As Object
    
    'set destination folder
    '(change as necessary and
    'make sure folder exists)...
    
    dfold = "C:\Users\jsmith\Documents\copies"
    
    'loop through source files and
    'copy to destination folder...
    
    sfile = Dir(sfold & Application.PathSeparator & "*.xls")
    Do While sfile <> vbNullString
        spath = sfold & Application.PathSeparator & sfile
        dpath = dfold & Application.PathSeparator & sfile
        FileCopy Source:=spath, Destination:=dpath
        sfile = Dir
    Loop
            
    'create recursive call for
    'subfolders of source folder...
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set gf = fso.GetFolder(sfold)
    
    For Each sf In gf.SubFolders
        copyfiles (sf.Path)
    Next
    
End Sub