Dear,
I have currently a table with hyperlinks to different folders, in each of those folders I can have more than 1 file. Based on the selected cells with the different hyperlinks I would like to copy all related files to 1 common folders.
There is already an example to copy pdf files to one folder but I need to use different hyperlinks with differents (when selected) path where more than 1 file must be selected an copied to the folder.
I tried to combine those 2 codes but did not get it to work unfortenatelly
Public Sub CopyFileHH()
Dim objFSO As Object
Dim objFil As Object
Dim rngCell As Range
Dim strOldDir As String
Const strNewDir As String = "C:3\Desktop\New folder\Try\New folder\"
strOldDir = "C:\Desktop\New folder\Try\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
For Each rngCell In Selection
Set objFil = objFSO.GetFile(strOldDir & rngCell.Hyperlinks(1).Address)
objFil.Copy strNewDir
Next rngCell
On Error GoTo 0
End Sub
Sub copyfilesa()
Dim source_file As String, dest_file As String
Dim source_path As String, dest_path As String
Dim i As Long, file_array As Variant
source_path = "C:\Desktop\New folder\Try\"
dest_path = "C:\Desktop\New folder\Try\New folder\"
source_file = Dir(source_path & "\" & "*.*")
Do Until source_file = ""
If Not IsArray(file_array) Then
ReDim file_array(0) As Variant
Else
ReDim Preserve file_array(UBound(file_array) + 1) As Variant
End If
file_array(UBound(file_array)) = source_file
source_file = Dir
Loop
'If new folder is not existed, create it.
If Dir(dest_path, 16) = "" Then MkDir dest_path '16=vbDirectory
For i = LBound(file_array) To UBound(file_array)
FileCopy source_path & "\" & file_array(i), dest_path & "\" & file_array(i)
Next i
End Sub
Bookmarks