AddIn per xslm einbinden
25.03.2020 12:35:30
Sven
ich benötige Hilfe. Schreibe das erste mal hier, nur zur Info.
Habe ein Makro gebaut, welches in einer xlsm Datei namens Addin Installer liegt. Diese stelle ich Kollegen zur Verfügung.
Wenn die Addin Installer Datei geöffnet wird, wird eine Makro aufgerufen was prüfen soll, ob ein bestimmtes Addin bereits existiert. Wenn nicht, wird von einem Netzwerklaufwerk eine Verknüpfung in den eigenen \Microsoft\Addin Order kopieren (Zentral.xlam.ink) und danach das Addin (Zentral.xlam) installieren. Darüber hinaus wird ein Button angelegt.
Zum Verständnis, dass Addin Zentral.xlam wiederum enthält Makros die die Kollegen dann verwenden können. Da das Zentral.xlam Addin schreibgeschützt ist, kann ich, nach aufheben des Schreibschutzes, Änderungen vornehmen. Das klappt soweit alles.
Folgende Probleme tauchen nun auf:
Zum einen findet er den Pfad nicht. Ich habe versucht den UNC-Pfad zu verwenden, habe diesen über cmd.exe ausgelesen und mehrfach überprüft aber irgendwo scheint der Wurm drin zu sein.
Zum anderen will er das Addin nicht installieren. Das kopieren funktioniert.
Anbei der Code
Option Explicit
Private Sub OKButton_Click()
With Application
.EnableEvents = False
End With
Me.Hide
'Autor: Sven
'Erstellt: 24.03.2020
'Update: -
Dim Addindatei As String
Dim AddinName As String
Dim AddinName2 As String
Dim AddinTitel As String
Dim pathvon As String
Dim pathzu As String
Dim Louis As String, LOG, UserN$, UserID$
Dim answer1 As String
UserN = Application.UserName 'der in Excel eingetragenen Name
UserID = Environ("Username") ' Der Anmeldename am Netzwerk
'************** Addin einbinden ********************
'Verzeichnes von wo / xxx wurden zum Datenschutz ersetzt ;)
pathvon = "\\xxx.168.xxx.21\Dokumente\Gemeinsame Dokumente\VBA\Neuer Ordner\"
'Welche Datei
AddinName = "Zentral.xlam"
AddinName2 = "Zentral.xlam.lnk"
AddinTitel = "Zentral"
'Verzeichnes nach wo
pathzu = Environ("AppData") & "\Microsoft\Addin\"
'pathzu = "C:\Users\" & UserID & "\AppData\Roaming\Microsoft\Addin\"
' Installiert und aktiviere Add-In-
CopyFileFSO pathvon & AddinName2, pathzu, True
'prüfen ob das Addin bereits installiert ist
If Len(Dir(pathzu & AddinName)) = 0 Then
'Wenn Addin noch nicht installiert ist, dass installier es nun.
With Application
.AddIns.Add(AddinName2, False).Installed = True
'.AddIns(AddinTitel).Installed = True
End With
Else
'Wenn Addin bereits installiert ist, fragen ob Button hinzugefügt werden sollen
answer1 = MsgBox("Du besitzt das Addin bereits. Möchtets du nun die Button hinzufü _
gen?", _
vbYesNo)
'Wenn antwort ja dann gehe zu Button hinzugügen
If answer1 = vbYes Then
GoTo aa
End If
End If
'************** Menü (RibbonBar) anpassen ********************
aa:
'CommandBars(1).reset
With CommandBars(1)
'********** Button 1 **********
.Controls.Add Type:=msoControlButton, before:=1
.Controls(1).Caption = "I5 Statistiken" 'Menüeintrag
.Controls(1).OnAction = "Neu" 'Zuweisen der Prozedur
.Controls(1).FaceId = 4207
.Controls(1).Style = msoButtonIconAndCaption
'********** Button 2 **********
' .Controls.add Type:=msoControlButton
' .Controls(2).Caption = " Sortieren" 'Menüeeintrag
' .Controls(2).OnAction = " Sortieren" 'Zuweisen der Prozedur
' .Controls(2).FaceId = 4207
' .Controls(2).Style = msoButtonIconAndCaption
End With
MsgBox "Die Installation wurde erfolgreich abgeschlossen." & vbCrLf & _
"Unter dem Menüpunkt Add-Ins ist das Add-In nun startbar."
With Application
.EnableEvents = True
End With
Unload Me
Application.DisplayAlerts = False
Workbooks.Close
Application.DisplayAlerts = True
End Sub
Private Function CopyFileFSO(strSourceFile As String, strTargetFile As String, _
Optional boolOverwrite As Boolean = True)
Dim ofso As Object
Set ofso = CreateObject("Scripting.FileSystemObject")
If boolOverwrite = True Then
ofso.CopyFile strSourceFile, strTargetFile
Else
ofso.CopyFile strSourceFile, strTargetFile, False
End If
End Function