Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 355
  • Last Modified:

Copy files from CD to hard drive

I have several files that I would like to copy automatically from a cd to a hard drive.  I am using Excel and I would like to have a dialog box to select a destination folder for the copied files.  The destination path of the files needs to be pasted into a cell in an excel file.
0
davidam
Asked:
davidam
  • 3
  • 2
1 Solution
 
Dave BrettCommented:
You can use Ken Pul's code from http://www.vbaexpress.com/kb/getarticle.php?kb_id=284 to dump a selected folder to A1 of sheet1 of the current file (by running the GetMe sub)

This code allows you to specify a default folder startinng point in the Function sub

Cheers

Dave


Option Explicit
 
Function BrowseForFolder(Optional OpenAt As Variant) As Variant
     'Function purpose:  To Browser for a user selected folder.
     'If the "OpenAt" path is provided, open the browser at that directory
     'NOTE:  If invalid, it will open at the Desktop level
     
    Dim ShellApp As Object
     
     'Create a file browser window at the default folder
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
     
     'Set the folder to that selected.  (On error in case cancelled)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0
     
     'Destroy the Shell Application
    Set ShellApp = Nothing
     
     'Check for invalid or non-entries and send to the Invalid error
     'handler if found
     'Valid selections can begin L: (where L is a letter) or
     '\\ (as in \\servername\sharename.  All others are invalid
    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
        If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
    Case Is = "\"
        If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
    Case Else
        GoTo Invalid
    End Select
     
    Exit Function
     
Invalid:
     'If it was determined that the selection was invalid, set to False
    BrowseForFolder = False
     
End Function

Sub GetMe()
Sheets(1).[a1] = BrowseForFolder
End Sub

Open in new window

0
 
davidamAuthor Commented:
I dont see how this is accessing the cd drive?
0
 
Dave BrettCommented:
I'd focussed on your retrieval of the path folder

The code below runs an xcopy from CD drive (I have presumed D:\) to the folderpath that you select

Cheers
Dave
Option Explicit
 
Function BrowseForFolder(Optional OpenAt As Variant) As Variant
     'Function purpose:  To Browser for a user selected folder.
     'If the "OpenAt" path is provided, open the browser at that directory
     'NOTE:  If invalid, it will open at the Desktop level
     
    Dim ShellApp As Object
     
     'Create a file browser window at the default folder
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
     
     'Set the folder to that selected.  (On error in case cancelled)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0
     
     'Destroy the Shell Application
    Set ShellApp = Nothing
     
     'Check for invalid or non-entries and send to the Invalid error
     'handler if found
     'Valid selections can begin L: (where L is a letter) or
     '\\ (as in \\servername\sharename.  All others are invalid
    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
        If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
    Case Is = "\"
        If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
    Case Else
        GoTo Invalid
    End Select
     
    Exit Function
     
Invalid:
     'If it was determined that the selection was invalid, set to False
    BrowseForFolder = False
     
End Function


Sub FolderSync2()
    Dim Path1 As String
    Dim Path2 As String
    Path1 = "D:"
    Sheets(1).[a1] = BrowseForFolder
    Path2 = Sheets(1).[a1]
    Call XcopyFiles(Path1, Path2)
End Sub
Sub XcopyFiles(strSource, strDestination)
Dim wsh
    Set wsh = CreateObject("wscript.shell")
    wsh.Run "xcopy.exe """ & strSource & """ """ & strDestination & """ /d /s /e /y /h /r", 1, True
    Set wsh = Nothing
End Sub

Open in new window

0
 
davidamAuthor Commented:
Looks good...will try in AM. Thanks!
0
 
davidamAuthor Commented:
Perfect.  Thank you!
0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now