We help IT Professionals succeed at work.

Copy Multiple Files To New Destination

G Scott
G Scott asked
on
So I was just playing around to see IF I can copy multiple files to a new location and I have got it working. The only problem with my code is you have to select the destination first. When I put the folder selection after the file selection it prompts me for a new destination for each file I have selected. How can I do this where I can select the files and then choose the destination? A HUGE thanks goes out to Helen Feddema for posting code that I could piece together.

  
Public Function SelectFile() As String
'Requires Office XP (2002) or higher
'Requires a reference to the Microsoft Office Object Library
'Created by Helen Feddema 3-Aug-2009
'Last modified 3-Aug-2009
'
'On Error GoTo ErrorHandler

   Dim fd As Office.FileDialog
   Dim varSelectedItem As Variant
   Dim strFileNameAndPath As String
    Dim strFolderPath As String
   Dim fds As Office.FileDialog
   Dim strPath As String
   Dim SelectFolder As String
   
   
   'Create a FileDialog object as a File Picker dialog box.
   Set fd = Application.FileDialog(msoFileDialogFilePicker)
   Set fds = Application.FileDialog(msoFileDialogFolderPicker)
   
   
      strPath = "c:\"

   With fds
      .Title = "Browse for folder where _________ are located"
      .ButtonName = "Select"
      .InitialView = msoFileDialogViewDetails
      '.InitialFileName = strPath
      If .Show = -1 Then
         strFolderPath = CStr(fd.SelectedItems.Item(1)) & "\"
      Else
         Debug.Print "User pressed Cancel"
         strFolderPath = ""
      End If
   End With
   
   SelectFolder = strFolderPath
   MsgBox SelectFolder
   
   
      Set fd = Application.FileDialog(msoFileDialogFilePicker)
   With fd
      'Set AllowMultiSelect to True to allow selection of multiple files
      .AllowMultiSelect = True
      
      .Title = "Browse for File"
      .ButtonName = "Select"
      .Filters.Clear
      .Filters.Add "Documents", "*.*", 1
'       .Filters.Add "Documents", "*.doc; *.txt", 1
      .InitialView = msoFileDialogViewDetails
      If .Show = -1 Then
         'Get selected item in the FileDialogSelectedItems collection
         For Each varSelectedItem In .SelectedItems
            strFileNameAndPath = CStr(varSelectedItem)
            Dim FileNameWithExt
            FileNameWithExt = Mid$(strFileNameAndPath, InStrRev(strFileNameAndPath, "\") + 1)
    
'            MsgBox FileNameWithExt
'            MsgBox varSelectedItem
'            MsgBox strFileNameAndPath
'            MsgBox SelectFolder
           FileCopy varSelectedItem, SelectFolder & FileNameWithExt
'
           
         Next varSelectedItem
        
         
      Else
         Debug.Print "User pressed Cancel"
         strFileNameAndPath = ""
      End If
   End With
   
   SelectFile = strFileNameAndPath
  
   
'ErrorHandlerExit:
'   Set fd = Nothing
'   Exit Function
'
'ErrorHandler:
'   MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
'   Resume ErrorHandlerExit

End Function

Open in new window


Thanks for any help on this.
Comment
Watch Question

View Solutions Only

CERTIFIED EXPERT
Commented:
Try this function:
Public Function SelectFile() As String
'Requires Office XP (2002) or higher
'Requires a reference to the Microsoft Office Object Library
'Created by Helen Feddema 3-Aug-2009
'Last modified 3-Aug-2009
'
'On Error GoTo ErrorHandler

   Dim fd As Office.FileDialog
   Dim varSelectedItem As Variant
   Dim strFileNameAndPath As String
    Dim strFolderPath As String
   Dim fds As Office.FileDialog
   Dim strPath As String
   Dim SelectFolder As String
   Dim FileNameWithExt
   Dim FDS_Not_Selected As Boolean
   FDS_Not_Selected = True
   'Create a FileDialog object as a File Picker dialog box.
   'Set fd = Application.FileDialog(msoFileDialogFilePicker)
   
   
   Set fd = Application.FileDialog(msoFileDialogFilePicker)
   With fd
      'Set AllowMultiSelect to True to allow selection of multiple files
      .AllowMultiSelect = True
      
      .Title = "Browse for File"
      .ButtonName = "Select"
      .Filters.Clear
      .Filters.Add "Documents", "*.*", 1
'       .Filters.Add "Documents", "*.doc; *.txt", 1
      .InitialView = msoFileDialogViewDetails
      If .Show = -1 Then
         'Get selected item in the FileDialogSelectedItems collection
         For Each varSelectedItem In .SelectedItems
            strFileNameAndPath = CStr(varSelectedItem)
            FileNameWithExt = Mid$(strFileNameAndPath, InStrRev(strFileNameAndPath, "\") + 1)
    
'            MsgBox FileNameWithExt
'            MsgBox varSelectedItem
'            MsgBox strFileNameAndPath
'            MsgBox SelectFolder
   If FDS_Not_Selected Then
    Set fds = Application.FileDialog(msoFileDialogFolderPicker)
    strPath = "c:\"

    With fds
      .Title = "Browse for folder where _________ are located"
      .ButtonName = "Select"
      .InitialView = msoFileDialogViewDetails
      '.InitialFileName = strPath
      If .Show = -1 Then
         strFolderPath = CStr(.SelectedItems.Item(1)) & "\"
      Else
         Debug.Print "User pressed Cancel"
         strFolderPath = ""
      End If
    End With
   
    SelectFolder = strFolderPath
    FDS_Not_Selected = False
    MsgBox SelectFolder
   End If
           
           FileCopy varSelectedItem, SelectFolder & FileNameWithExt
'
           
         Next varSelectedItem
        
         
      Else
         Debug.Print "User pressed Cancel"
         strFileNameAndPath = ""
      End If
   End With
   
   SelectFile = strFileNameAndPath
  
   
'ErrorHandlerExit:
'   Set fd = Nothing
'   Exit Function
'
'ErrorHandler:
'   MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
'   Resume ErrorHandlerExit

End Function

Open in new window

Helen Feddema
CERTIFIED EXPERT
Top Expert 2009

Commented:
I like to use the folder selection code running from a command button on the main menu, and saving the folder path to a custom database property.  That way you can get the path wherever you need it in code throughout the database.  Here is a variation of the SelectFolder code that uses this method:
Private Sub cmdDocumentsPath_Click()
'Created by Helen Feddema 12-Jun-2011
'Last modified by Helen Feddema 25-Jun-2011

On Error GoTo ErrorHandler

   'Create a FileDialog object as a Folder Picker dialog box.
   Set fd = Application.FileDialog(msoFileDialogFolderPicker)
   Set txt = Me![txtDocumentsPath]
   strPropertyName = "DocumentsPath"
   strPath = GetProperty(strPropertyName, "")
   
   With fd
      .Title = "Browse for folder where workbooks and PDF documents " _
         & "should be stored"
      .ButtonName = "Select"
      .InitialView = msoFileDialogViewDetails
      .InitialFileName = strPath
      If .Show = -1 Then
         strPropertyValue = CStr(fd.SelectedItems.Item(1))
         lngDataType = dbText
         Call SetProperty(strPropertyName, lngDataType, _
            strPropertyValue)
         txt.Value = strPropertyValue
      Else
         Debug.Print "User pressed Cancel"
      End If
   End With

ErrorHandlerExit:
   Exit Sub

ErrorHandler:
   MsgBox "Error No: " & Err.Number _
      & " in " & Me.ActiveControl.Name & " procedure; " _
      & "Description: " & Err.Description
   Resume ErrorHandlerExit

End Sub

Open in new window

Helen Feddema
CERTIFIED EXPERT
Top Expert 2009

Commented:
To retrieve the path, use this syntax:

GetProperty("DocumentsPath", "")
Helen Feddema
CERTIFIED EXPERT
Top Expert 2009
Commented:
Here are the supporting procedures for saving and retrieving custom database properties, and some syntax examples:
Option Compare Database
Option Explicit

Private dbs As DAO.Database
Private prp As DAO.Property
Private prps As DAO.Properties
Private strPropertyName As String
Private strPropertyValue As String
Private lngDataType as Long
Private varPropertyValue As Variant


Public Sub SetProperty(strName As String, lngType As Long, _
   varValue As Variant)
'Created by Helen Feddema 2-Oct-2006
'Modified by Helen Feddema 2-Oct-2006
'Called from various procedures

On Error GoTo ErrorHandler

   'Attempt to set the specified property
   Set dbs = CurrentDb
   Set prps = dbs.Properties
   prps(strName) = varValue

ErrorHandlerExit:
   Exit Sub

ErrorHandler:
    If Err.Number = 3270 Then
      'The property was not found; create it
      Set prp = dbs.CreateProperty(Name:=strName, _
         Type:=lngType, Value:=varValue)
      dbs.Properties.Append prp
      Resume Next
   Else
   MsgBox "Error No: " & Err.Number _
      & " in SetProperty procedure; " _
      & "Description: " & Err.Description
      Resume ErrorHandlerExit
   End If

End Sub

Public Function GetProperty(strName As String, strDefault As String) _
   As Variant
'Created by Helen Feddema 2-Oct-2006
'Modified by Helen Feddema 2-Oct-2006
'Called from various procedures

On Error GoTo ErrorHandler
   
   'Attempt to get the value of the specified property
   Set dbs = CurrentDb
   GetProperty = dbs.Properties(strName).Value

ErrorHandlerExit:
   Exit Function

ErrorHandler:
   If Err.Number = 3270 Then
      'The property was not found; use default value
      GetProperty = strDefault
      Resume Next
   Else
      MsgBox "Error No: " & Err.Number _
         & " in GetProperty procedure; " _
         & "Description: " & Err.Description
      Resume ErrorHandlerExit
   End If

End Function

Public Function ListCustomProps()
'Created by Helen Feddema 3-Oct-2006
'Modified by Helen Feddema 3-Oct-2006
'Lists DB properties created in code (as well as built-in properties)

On Error Resume Next
   
   Set dbs = CurrentDb
   Debug.Print "Database properties:"
   
   For Each prp In dbs.Properties
      Debug.Print vbTab & prp.Name & ": " & prp.Value
   Next prp

End Function

==================================
Usage examples:

Private dbs As DAO.Database
Private prp As DAO.Property
Private prps As DAO.Properties
Private lngDataType As Long
Private strPropertyName As String
Private strPropertyValue as String
Private varPropertyValue As Variant

Date
====
   strPropertyName = "PropName"
   lngDataType = dbDate
   Call SetProperty(strPropertyName, lngDataType, dteStart)

   GetStartDate = CDate(GetProperty("PropName", ""))

Text
====
   strPropertyName = "PropName"
   strPropertyValue = CStr(cbo.Value)
   lngDataType = dbText
   Call SetProperty(strPropertyName, lngDataType, _
      strPropertyValue )

   strDocsPath = GetProperty("PropName", "")

Long
====
   strPropertyName = "PropName"
   lngDataType = dbLong
   Call SetProperty(strPropertyName, lngDataType, lngID)

   lngID = CLng(GetProperty("PropName", ""))

Integer
=======
   strPropertyName = "PropName"
   lngDataType = dbInteger
   Call SetProperty(strPropertyName, lngDataType, intMonth)

   intID = CInt(GetProperty("PropName", ""))

Saving to a custom property from a control's AfterUpdate event
==============================================================
Private Sub txtDate_AfterUpdate()
'Created by Helen Feddema 2-Sep-2009
'Last modified 2-Sep-2009

On Error GoTo ErrorHandler
   
   If IsDate(Me![txtDate].Value) = True Then
      dteSingle = CDate(Me![txtDate].Value)
      strPropertyName = "SingleDate"
      Call SetProperty(strName:=strPropertyName, _
         lngType:=dbDate, varValue:=dteSingle)
   End If
   
ErrorHandlerExit:
   Exit Sub

ErrorHandler:
   MsgBox "Error No: " & Err.Number & "; Description: " & _
      Err.Description
   Resume ErrorHandlerExit

End Sub

Open in new window

Helen Feddema
CERTIFIED EXPERT
Top Expert 2009

Commented:
Note that you were originally using the SelectFile procedure, which selects a file.  I have another procedure for selecting a folder.
G Scott

Author

Commented:
Sorry for the reply delay. Thanks for the solutions. Helen-that is an awesome solution.

Explore More ContentExplore courses, solutions, and other research materials related to this topic.