Results 1 to 4 of 4

Thread: Copying files to specific folder

  1. #1
    Board Regular
    Join Date
    Jun 2009
    Posts
    64
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Copying files to specific folder

    I've put the following code together to copy specific files from one folder to another based on a list contained in a spreradsheet. There are 2 problems which I'd appreaciatte some help with

    1 the kill instuction doesn't work

    and

    2 the code is copying all of the files, not the ones identified in the list in the spreadsheet.

    Thanks
    Geoff


    Sub copy_specific_files_in_folder()


    Dim fso As Object
    Dim sourcePath As String
    Dim destinationPath As String
    Dim xSPathStr As Variant, xDPathStr As Variant
    Dim xRg As Range, xCell As Range
    Dim fileExtn As String
    Dim xVal As String
    Dim ws As Worksheet


    sourcePath = ThisWorkbook.Sheets("draft Intro").Range("B10")
    destinationPath = ThisWorkbook.Sheets("draft Intro").Range("B22")
    fileExtn = ".txt"


    If Right(sourcePath, 1) <> "" Then
    sourcePath = sourcePath & ""
    End If


    Set fso = CreateObject("scripting.filesystemobject")


    If fso.folderexists(sourcePath) = False Then
    MsgBox sourcePath & " does not exist"
    Exit Sub
    End If


    If fso.folderexists(destinationPath) = False Then
    MsgBox sourcePath & " does not exist"
    Exit Sub
    End If


    'delete existing files


    On Error Resume Next
    Kill destinationPath & ".txt"
    On Error GoTo 0


    On Error Resume Next


    Set xRg = Application.Worksheets("draft Intro").Range("H53:H4318")


    For Each xCell In xRg
    xVal = xCell.Value
    If TypeName(xVal) = "String" And xVal <> "" Then
    FileCopy sourcePath & xVal & fileExtn, destinationPath & xVal & fileExtn

    End If
    Next


    'FSO.copyfile Source:=sourcePath & fileExtn, destination:=destinationPath
    'MsgBox "files have been copied from " & sourcePath & vbCr & "to" & destinationPath


    End Sub

  2. #2
    MrExcel MVP
    Join Date
    Oct 2007
    Posts
    5,904
    Post Thanks / Like
    Mentioned
    8 Post(s)
    Tagged
    2 Thread(s)

    Default Re: Copying files to specific folder

    Try these changes (untested etc.)
    Code:
    If Right(destinationPath , 1) <> "\" Then destinationPath = destinationPath & "\"
    Code:
    'delete existing files
    fso.DeleteFile(destinationPath & "*.txt"), True
    The rest of it looks correct, though I would remove the On Error Resume Next to see if any errors occur.

  3. #3
    MrExcel MVP AlphaFrog's Avatar
    Join Date
    Sep 2009
    Posts
    16,102
    Post Thanks / Like
    Mentioned
    17 Post(s)
    Tagged
    7 Thread(s)

    Default Re: Copying files to specific folder

    Code:
    Sub copy_specific_files_in_folder()
        
        Dim strSrc    As String
        Dim strDest   As String
        Dim strFile   As String
        Dim vRg       As Variant
        Dim vVal      As Variant
        Dim counter   As Long
        Const strExt  As String = ".txt"
        
        With ThisWorkbook.Sheets("draft Intro")
            
            'Source path
            strSrc = .Range("B10")
            If strSrc = Empty Then
                MsgBox "No 'Source' path listed in cell B10", vbExclamation, "Invalid Entry"
                Application.Goto .Range("B10")
                Exit Sub
            End If
            If Dir(strSrc, vbDirectory) = "" Then
                MsgBox strSrc, vbExclamation, "Source Folder Does Not Exist"
                Application.Goto .Range("B10")
                Exit Sub
            End If
            If Right(strSrc, 1) <> "\" Then strSrc = strSrc & "\"
            
            'Destination path
            strDest = .Range("B22")
            If strDest = Empty Then
                MsgBox "No 'Destination' path listed in cell B22", vbExclamation, "Invalid Entry"
                Application.Goto .Range("B22")
                Exit Sub
            End If
            If Dir(strDest, vbDirectory) = "" Then
                MsgBox strDest, vbExclamation, "Destination Folder Does Not Exist"
                Application.Goto .Range("B22")
                Exit Sub
            End If
            If Right(strDest, 1) <> "\" Then strDest = strDest & "\"
            
            'delete existing files in destination folder
            strFile = Dir(strDest & "*" & strExt)
            Do While strFile <> ""
                Kill strDest & strFile
                strFile = Dir
            Loop
            
            'Copy file list
            vRg = .Range("H53:H4318").Value
            For Each vVal In vRg
                If vVal <> Empty Then
                    If Dir(strSrc & vVal & strExt) <> "" Then 'if file exists
                        FileCopy strSrc & vVal & strExt, strDest & vVal & strExt
                        counter = counter + 1
                    End If
                End If
            Next
        
        End With
        
        MsgBox "From: " & vbCr & strSrc & vbCr & vbCr & _
               "To:" & vbCr & strDest, vbInformation, _
               counter & " files have been copied."
        
    End Sub
    Last edited by AlphaFrog; Oct 18th, 2019 at 08:35 AM.
    Paste your Excel data to the forum...
    MrExcel HTML Maker or Excel Jeanie

    How to post your vba code
    [CODE]your VBA code here[/CODE]
    The # button in the forum's editor will apply CODE tags around your selected text.

  4. #4
    Board Regular
    Join Date
    Jun 2009
    Posts
    64
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Copying files to specific folder

    John_w & AlphaFrog,

    Thank you for these useful solutions. Both work.

    Geoff

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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