Consulting

Results 1 to 4 of 4

Thread: Solved: Copy files given location to a new location

  1. #1

    Solved: Copy files given location to a new location

    Hi, I found this link and it is nearly what I want.
    vbaexpress.com/kb/getarticle.php?kb_id=827
    But instead of copying a whole folder, I would like to copy only selected files. Basically what I am doing is I have a playlist made in Itunes. I can export that playlist as a text file and then copy it into excel. So one columns in the sheet will contain the file's location of all the songs in the playlist. So I need the macro to go through and grab all these files, and then copy them to a new folder.
    So the end goal is to have a new folder full of only the songs that I had in my playlist.
    Can anyone help me out please? Some kind of do while loop is required I think, which I can do. But I am not sure how to get this macro to grab the file from the location in the sheet. I can sort of hack my way through VBA, I have some experience. But no experience with stuff outside of normal excel stuff.

  2. #2
    VBAX Contributor
    Joined
    May 2010
    Location
    Sydney, NSW, Australia
    Posts
    170
    Location
    You can use VBA if you want but for a once use item like this I usually do the following:

    A1:A20 contain file names
    B1 formula ="COPY "".\" & A1 & """ ""NewLocation"""

    Drag down to B20

    Copy B1:B20

    Open notepad

    paste

    save to the folder where the MP3's are change the type to "all files" (from "text files") and call it go.bat

    Double click the new file (go.bat) and watch it run.

    NewLocation should be a full path like C:\Music\MyPlaylist

  3. #3
    Thanks, but this will be more than a one time use so I would like to get the macro figured out. I guess basically I just need to know the commands to get a certain file copied where the file name is in A1:A20 or whatever the case may be. I tried to modify the code from the link, but I can't quite get it.

  4. #4
    Got it! Here is my code. I've never done anything like this so I just had to figure out the code. A little research and troubleshooting with F8 got me through it.

    Sub Copy_Certain_Files_In_Folder()
    'This example copy all Excel files from FromPath to ToPath.
    'Note: If the files in ToPath already exist it will overwrite
    'existing files in this folder
    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String
    Dim FileExt As String
    Dim intRow, Counter As Integer

    Application.ScreenUpdating = False 'turn screenupdating off
    Application.EnableEvents = False 'turn events off

    ToPath = "C:\Users\Matt\New 14.8GB Playlist\" '<< Change
    'below will verify that the specified destination path exists, or it will create it:
    On Error Resume Next
    x = GetAttr(ToPath) And 0
    If Err = 0 Then 'if there is no error, continue below
    PathExists = True 'if there is no error, set flag to TRUE
    Overwrite = MsgBox("The folder may contain duplicate files," & vbNewLine & _
    "Do you wish to overwrite existing files with same name?", vbYesNo, "Alert!")
    'message to alert that you may overwrite files of the same name since folder exists
    If Overwrite <> vbYes Then Exit Sub 'if the user clicks YES, then exit the routine..
    Else: 'if path does NOT exist, do the next steps
    PathExists = False 'set flag at false
    If PathExists = False Then MkDir (ToPath) 'If path does not exist, make a new one
    End If 'end the conditional testing

    Dim oFS As FileSystemObject
    Counter = 0
    intRow = 581
    Do While Range("A" & intRow) <> ""
    FromPath = Range("A" & intRow) '<< Change

    Range("B" & intRow) = FromPath

    Set FSO = CreateObject("scripting.filesystemobject")
    If Dir(FromPath) <> "" Then
    Range("B" & intRow) = "copy complete"
    Else
    Range("B" & intRow) = FromPath & " doesn't exist"
    'Exit Sub 'quit the sub if the file does not exist
    End If
    FSO.CopyFile Source:=FromPath, Destination:=ToPath

    intRow = intRow + 1
    Counter = Counter + 1
    Loop
    MsgBox "You can find the files from " & FromPath & " in " & ToPath & ", and " & Counter & " files were copied."
    Application.ScreenUpdating = True 'turn screenupdating back on
    Application.EnableEvents = True 'turn events back on
    End Sub

Posting Permissions

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