Sub fcopy()
Dim hLink As Hyperlink
Dim SourceRoot, TargetRoot, TargetPath, SourceFile, TargetFile As String
SourceRoot = "D:\Temp\Tima"
TargetRoot = "D:\timatarget\audio"
If Not FileOrDirExists(TargetRoot) Then
MkDir TargetRoot
End If
With ActiveSheet
For Each hLink In .Hyperlinks
TargetPath = TargetRoot & "\" & .Range("O" & ActiveCell.Row).Value
SourceFile = SourceRoot & "\" & hLink.Address
TargetFile = TargetPath & "\" & hLink.Name
SourceFile = Replace(SourceFile, "/", "\")
If FileOrDirExists(SourceFile) Then
If Not FileOrDirExists(TargetPath) Then
MkDir TargetPath
End If
filecopy SourceFile, TargetFile
.Range("AA" & ActiveCell.Row).Value = ""
Else
.Range("AA" & ActiveCell.Row).Value = "File missing"
End If
Next hLink
End With
End Sub
Bookmarks