P
pauloreiss
I've found many useful codes in this forum and used them to create the
following macro. But it's making erros because of a my modifications to
the codes i've found.
HOW IT WORKS:
Cell D6 contains de path to search the files.
Cell D10 and D12 contains the first and last part of the name to be
used as criteria of the filesearch.
Cell D8 contains the path where the file is going to be saved after the
links are updated and broken.
PROBLEMS:
I don't know how to make the breaklink function break all links of the
file.
The ActiveWorkbook.SaveAs function is not working well because it is
not saving the file in the path entered in the Cell D8.
CODE:
Sub Update()
Set fs = Application.FileSearch
With fs
..LookIn = Range("D6").Value
..Filename = Range("D10").Value & "*" & Range("D12").Value
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
nm = Mid(.FoundFiles(i), InStrRev(.FoundFiles(i), "\") + 1, _
Len(.FoundFiles(i)))
MsgBox Range("D8").Value & nm 'The name of the path with the filename
is correct
Workbooks.Open (.FoundFiles(i))
ActiveWorkbook.UpdateLink Name:=ActiveWorkbook.LinkSources
ActiveWorkbook.SaveAs Filename:=Range("D8").Value & nm
Dim astrLinks As Variant
astrLinks = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
For b = 1 To .linksourses.Count
ActiveWorkbook.BreakLink _
Name:=astrLinks(b), _
Type:=xlLinkTypeExcelLinks
Next b
MsgBox nm & " updated."
ActiveWindow.Close
Next i
Else
MsgBox "There are no files in this directory."
End If
End With
End Sub
following macro. But it's making erros because of a my modifications to
the codes i've found.
HOW IT WORKS:
Cell D6 contains de path to search the files.
Cell D10 and D12 contains the first and last part of the name to be
used as criteria of the filesearch.
Cell D8 contains the path where the file is going to be saved after the
links are updated and broken.
PROBLEMS:
I don't know how to make the breaklink function break all links of the
file.
The ActiveWorkbook.SaveAs function is not working well because it is
not saving the file in the path entered in the Cell D8.
CODE:
Sub Update()
Set fs = Application.FileSearch
With fs
..LookIn = Range("D6").Value
..Filename = Range("D10").Value & "*" & Range("D12").Value
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
nm = Mid(.FoundFiles(i), InStrRev(.FoundFiles(i), "\") + 1, _
Len(.FoundFiles(i)))
MsgBox Range("D8").Value & nm 'The name of the path with the filename
is correct
Workbooks.Open (.FoundFiles(i))
ActiveWorkbook.UpdateLink Name:=ActiveWorkbook.LinkSources
ActiveWorkbook.SaveAs Filename:=Range("D8").Value & nm
Dim astrLinks As Variant
astrLinks = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
For b = 1 To .linksourses.Count
ActiveWorkbook.BreakLink _
Name:=astrLinks(b), _
Type:=xlLinkTypeExcelLinks
Next b
MsgBox nm & " updated."
ActiveWindow.Close
Next i
Else
MsgBox "There are no files in this directory."
End If
End With
End Sub