Sub Install_Reference()
Dim CheckRef As String
CheckRef = "alte.xla"
Dim RefName As String
Suchpfad = "L:\Dokumentation_test\"
Dim refpfad As String
refpfad = "L:\Dokumentation_test\neue.xla"
Dim cDir As String
cDir = Dir(Suchpfad & "*.xls")
Do While cDir <> ""
Application.EnableEvents = False
Workbooks.Open (Suchpfad & cDir)
Dateizahler = Dateizahler + 1
Workbooks(cDir).Activate
If ResCheckReference(CheckRef) = True Then
MsgBox "Verweis ist bereits installiert"
RefName = VerweisPrüfen(CheckRef, cDir)
VerweiseLöschen (RefName)
End If
VerweiseHinzufügen (refpfad)
MsgBox "Referenz auf : " & CheckRef & " wurde erstellt"
ActiveWorkbook.Save
ActiveWorkbook.Close False
cDir = Dir
Loop
Application.ScreenUpdating = True
End Sub
Function VerweisPrüfen(CheckRef As String, cDir As String)
Dim objRef As Object
For Each objRef In ActiveWorkbook.VBProject.references
With objRef
If InStr(1, objRef.FullPath, CheckRef) > 0 Then
RefName = objRef.Name
VerweisPrüfen = RefName
Exit Function
End If
End With
Next
End Function
Public Function ResCheckReference(CheckRef As String) As Boolean
Dim objRef As Object
For Each objRef In ActiveWorkbook.VBProject.references
With objRef
Debug.Print objRef.FullPath
If InStr(1, objRef.FullPath, CheckRef) > 0 Then
ResCheckReference = True
Exit Function
End If
End With
Next
ResCheckReference = False
End Function
Sub VerweiseLöschen(delRef As String)
Dim objRef As Object
For Each objRef In ActiveWorkbook.VBProject.references
With objRef
If objRef.Name = delRef Then
ActiveWorkbook.VBProject.references.Remove objRef
End If
End With
Next
End Sub
Sub VerweiseHinzufügen(addRef As String)
Dim objRef As Object
With objRef
Set objRef = objRef.AddFromFile(addRef)
End With
End Sub