EMONTES149
New Member
- Joined
- Dec 20, 2016
- Messages
- 8
I am having trouble with the following code. It appears to be a very simple answer that eludes me. There is a Master Director that certain files will be copied from to a folder of the users choosing. I used the folder selector dialogue box for the selection but no matter which folder the user selects it always goes to the desktop. I cannot figure it out. Can some one help me with this apparently easy solution that apparently is not easy for me. Here is the code:
Sub Test()
Dim R As Range
Dim SourcePath As String
Dim DestPath As String
Dim FName As String
'THIS IS THE ONE TO USE TO SELECT THE SPEC SECTIONS BASED ON THE CHECKLIST. THIS WORKS WELL AND WITH HIDDEN ROWS
'Setup source and dest path (Note: must have a trailing backslash!)
SourcePath = "O:\SYS2\RENOVATIONS\Design\ADMINISTRATION\Specifications\Master Specification Sections"
'DestPath = "C:\Users\EMONT3\Desktop\test" (this is what I am trying to avoid - hard coding to a path)
MsgBox "On Next Screen Select Project Folder"
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
On Error Resume Next
FolderName = .SelectedItems(1)
Err.Clear
On Error GoTo 0
End With
'Visit each used cell in column A
For Each R In Range("A3", Range("A" & Rows.Count).End(xlUp))
If R.EntireRow.Hidden = False Then
R.EntireRow.Offset(1, 0).Select
'Search the file with the file mask from the cell (Note: can contain wildcards like *.xls)
FName = Dir(SourcePath & R)
'Loop while files found
Do While FName <> ""
'Copy the file
FileCopy SourcePath & FName, DestPath & FName
'Search the next file
FName = Dir()
Loop
End If
Next
End Sub
Sub Test()
Dim R As Range
Dim SourcePath As String
Dim DestPath As String
Dim FName As String
'THIS IS THE ONE TO USE TO SELECT THE SPEC SECTIONS BASED ON THE CHECKLIST. THIS WORKS WELL AND WITH HIDDEN ROWS
'Setup source and dest path (Note: must have a trailing backslash!)
SourcePath = "O:\SYS2\RENOVATIONS\Design\ADMINISTRATION\Specifications\Master Specification Sections"
'DestPath = "C:\Users\EMONT3\Desktop\test" (this is what I am trying to avoid - hard coding to a path)
MsgBox "On Next Screen Select Project Folder"
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
On Error Resume Next
FolderName = .SelectedItems(1)
Err.Clear
On Error GoTo 0
End With
'Visit each used cell in column A
For Each R In Range("A3", Range("A" & Rows.Count).End(xlUp))
If R.EntireRow.Hidden = False Then
R.EntireRow.Offset(1, 0).Select
'Search the file with the file mask from the cell (Note: can contain wildcards like *.xls)
FName = Dir(SourcePath & R)
'Loop while files found
Do While FName <> ""
'Copy the file
FileCopy SourcePath & FName, DestPath & FName
'Search the next file
FName = Dir()
Loop
End If
Next
End Sub
