Results 1 to 9 of 9

Thread: Copy files from one folder and subfolder to another based on a list in Excel

  1. #1
    Neophyte inasr's Avatar
    Join Date
    Sep 2019
    Posts
    4
    Articles
    0
    Excel Version
    2016

    Copy files from one folder and subfolder to another based on a list in Excel



    Register for a FREE account, and/
    or Log in to avoid these ads!

    Hello
    I'm very new to VBA ,
    at the moment I'm using the following code to Copy files from one folder to another based on a list in Excel, and it work perfect
    but it search just folder not subfolders any idea how to edit the code to achieve this task
    Code:
    Sub copyfiles()
    Dim xRg As Range, xCell As Range
    Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
    Dim xSPathStr As Variant, xDPathStr As Variant
    Dim xVal As String
    On Error Resume Next
    SetxRg = Application.InputBox("Please select the file names:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Set xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    xSFileDlg.Title = "Please select the original folder:"
    If xSFileDlg.Show <> -1 Then Exit Sub
    xSPathStr = xSFileDlg.SelectedItems.Item(1) & ""
    Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    xDFileDlg.Title = "Please select the destination folder:"
    If xDFileDlg.Show <> -1 Then Exit Sub
    xDPathStr = xDFileDlg.SelectedItems.Item(1) & ""
    For Each xCell In xRg
    xVal = xCell.Value
    If TypeName(xVal) = "String" And xVal <> "" Then
    FileCopy xSPathStr & xVal, xDPathStr & xVal
    End If
    Next
    End Sub
    many thanks
    Last edited by p45cal; 2019-09-30 at 06:53 PM. Reason: Code tags added. Changed Title

  2. #2
    Administrator AliGW's Avatar
    Join Date
    Nov 2015
    Location
    Ipswich, Suffolk, England
    Posts
    1,275
    Articles
    0
    Excel Version
    Office 365 Subscription
    Please improve your thread title - it needs to tell us what you are trying to do.

    mod edit: Done. p45cal.
    Last edited by p45cal; 2019-09-30 at 06:52 PM.
    Ali
    Enthusiastic self-taught user of MS Excel!

  3. #3
    Neophyte inasr's Avatar
    Join Date
    Sep 2019
    Posts
    4
    Articles
    0
    Excel Version
    2016

    Copy files from one folder and subfolder to another based on a list in Excel

    Quote Originally Posted by AliGW View Post
    Please improve your thread title - it needs to tell us what you are trying to do.
    Thank you for your reply will do

  4. #4
    Super Moderator Bob Phillips's Avatar
    Join Date
    Mar 2011
    Posts
    1,673
    Articles
    0
    Excel Version
    O365
    Untested, but try this

    Code:
    Sub copyfiles()
    Dim xRg As Range, xCell As Range
    Dim fldr As Object
    Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
    Dim xSPathStr As Variant, xDPathStr As Variant
        On Error Resume Next
        
        Set xRg = Application.InputBox("Please select the file names:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
        If xRg Is Nothing Then Exit Sub
        
        Set xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
        xSFileDlg.Title = "Please select the original folder:"
        If xSFileDlg.Show <> -1 Then Exit Sub
        xSPathStr = xSFileDlg.SelectedItems.Item(1) & vbNullString
        
        Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
        xDFileDlg.Title = "Please select the destination folder:"
        If xDFileDlg.Show <> -1 Then Exit Sub
        xDPathStr = xDFileDlg.SelectedItems.Item(1) & vbNullString
        
        CopySelected xSPathStr, xDPathStr, xRg
        For Each fldr In CreateObject("Scripting.FileSystemObject").GetFolder(xDPathStr & Application.PathSeparator).subFolders
        
            CopySelected fldr.Path, xDPathStr, xRg
        Next fldr
    End Sub
    Private Function CopySelected( _
        ByVal OrigPath As String, _
        ByVal DestPath As String, _
        ByRef rng As Range)
    Dim xCell As Range
    Dim xVal As String
        For Each xCell In rng
        
            xVal = xCell.Value
            If TypeName(xVal) = "String" And xVal <> "" Then
            
                FileCopy OrigPath & Application.PathSeparato & xVal, DestPath & Application.PathSeparator & xVal
            End If
        Next
    End Function
    

  5. #5
    Super Moderator p45cal's Avatar
    Join Date
    Dec 2012
    Posts
    1,607
    Articles
    0
    Excel Version
    365
    cross posted without links:
    https://www.mrexcel.com/forum/excel-...ist-excel.html
    https://www.excelforum.com/excel-pro...ml#post5202556

    inasr
    , for your information, you should always provide links to your cross posts.
    This is a requirement, not just a request.
    If you have cross posted at other places, please add links to them too.
    Why? Have a read of http://www.excelguru.ca/content.php?184

  6. #6
    Neophyte inasr's Avatar
    Join Date
    Sep 2019
    Posts
    4
    Articles
    0
    Excel Version
    2016
    Quote Originally Posted by p45cal View Post
    cross posted without links:
    https://www.mrexcel.com/forum/excel-...ist-excel.html
    https://www.excelforum.com/excel-pro...ml#post5202556

    inasr
    , for your information, you should always provide links to your cross posts.
    This is a requirement, not just a request.
    If you have cross posted at other places, please add links to them too.
    Why? Have a read of http://www.excelguru.ca/content.php?184
    looks like I'm not doing very well here
    silly question how to edit the post ?
    thanks

  7. #7
    Neophyte inasr's Avatar
    Join Date
    Sep 2019
    Posts
    4
    Articles
    0
    Excel Version
    2016
    Quote Originally Posted by Bob Phillips View Post
    Untested, but try this

    Code:
    Sub copyfiles()
    Dim xRg As Range, xCell As Range
    Dim fldr As Object
    Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
    Dim xSPathStr As Variant, xDPathStr As Variant
        On Error Resume Next
        
        Set xRg = Application.InputBox("Please select the file names:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
        If xRg Is Nothing Then Exit Sub
        
        Set xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
        xSFileDlg.Title = "Please select the original folder:"
        If xSFileDlg.Show <> -1 Then Exit Sub
        xSPathStr = xSFileDlg.SelectedItems.Item(1) & vbNullString
        
        Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
        xDFileDlg.Title = "Please select the destination folder:"
        If xDFileDlg.Show <> -1 Then Exit Sub
        xDPathStr = xDFileDlg.SelectedItems.Item(1) & vbNullString
        
        CopySelected xSPathStr, xDPathStr, xRg
        For Each fldr In CreateObject("Scripting.FileSystemObject").GetFolder(xDPathStr & Application.PathSeparator).subFolders
        
            CopySelected fldr.Path, xDPathStr, xRg
        Next fldr
    End Sub
    Private Function CopySelected( _
        ByVal OrigPath As String, _
        ByVal DestPath As String, _
        ByRef rng As Range)
    Dim xCell As Range
    Dim xVal As String
        For Each xCell In rng
        
            xVal = xCell.Value
            If TypeName(xVal) = "String" And xVal <> "" Then
            
                FileCopy OrigPath & Application.PathSeparato & xVal, DestPath & Application.PathSeparator & xVal
            End If
        Next
    End Function
    
    Thank you no didn't work still search only parent folder

  8. #8
    Administrator Pecoflyer's Avatar
    Join Date
    Oct 2011
    Location
    Brussels Belgium
    Posts
    1,675
    Articles
    0
    Excel Version
    2010 on Xubuntu
    Please don't quote entire posts unnecessarily. It clutters the thread and makes it hard to read. Thanks
    Thank you Ken for this secure forum.

  9. #9
    Super Moderator Bob Phillips's Avatar
    Join Date
    Mar 2011
    Posts
    1,673
    Articles
    0
    Excel Version
    O365
    Quote Originally Posted by inasr View Post
    Thank you no didn't work still search only parent folder
    Really? I can believe that it might fail somehow, but not that it just processes the parent folder.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •