Update-Button in Toolbar
25.10.2018 14:34:46
Steffen
Das ganze funktioniert so, dass mit Klick auf den Update-Button eine ppt-Datei aus dem Addin-Verzeichnis aufgerufen wird die das Makro enthält um das AddIn zu entladen und aus dem Netzwerk dann die neue Datei kopiert und sie einbindet. Den Kopiervorgang realisiere ich über das "FileSystemObject".
In den Tests auf meinem PC hat das alles sauber funktioniert aber leider erhalte ich jetzt, als ich bei einem Kollegen das ganze mal zu Testzwecken eingebunden habe für den Kopiervorgang den "Fehler 70: Kein Zugriff". Ich vermute dass wenn ein anderer Nutzer es bereits geladen hat, dieser Fehler auftritt, was sich mir aber nicht erklärt da man ja auf die eigene Datei im AddIn-Ordner zugreift und nicht auf das Original im Netzwerk. Ich scheitere leider gerade daran herauszufinden warum Powerpoint so reagiert.
Mein Makro um das AddIn zu entladen und neu einzubinden sieht bisher so aus:
Sub DoIntegration()
Dim eai As PowerPoint.AddIn
Dim fso As FileSystemObject 'Object
Dim userName As String: userName = Environ("Username") 'Environ$("Username")
Dim AddInsPath As String: AddInsPath = "C:\Users\" & userName & "\AppData\Roaming\ _
Microsoft\AddIns\"
Dim existingAddInName As String: existingAddInName = "Tools.ppam"
Dim existingAddInDate As Date
Dim existingFileLen As Long
Dim desiredAddInName As String: desiredAddInName = "Makro.ppam"
Dim desiredAddInPath As String: desiredAddInPath = "Laufwerk:\Unterordner\_PPT_addin\"
Dim desiredAddInFull As String: desiredAddInFull = desiredAddInPath & desiredAddInName
Dim desiredAddInDate As Date
Dim desiredAddInLen As Long
Dim deleteOld As Boolean: deleteOld = True
Dim potPath As String: potPath = "C:\Users\" & userName & "\AppData\Roaming\ _
Microsoft\AddIns\"
Dim potName As String: potName = "Toolbar-Updater.pptm"
Dim potFull As String: potFull = potPath & potName
'Prüfe ob das AddIn richtig benannt ist
Set fso = CreateObject("Scripting.FileSystemObject")
fso.FileExists (existingAddInName)
Set fso = Nothing
'Prüfe ob das AddIn geladen ist
If AddIns(existingAddInName) Is Nothing Then
'Erstelle ein File System Object um die Existenz der Vgl.-Datei zu prüfen
Set fso = New FileSystemObject
'Wenn das Ziel existiert, setze die Verweise
If fso.FileExists(desiredAddInFull) Then
'Sonst brich den Vorgang ab
Else
MsgBox "Die 'neue' Datei existiert nicht!" & vbNewLine _
& "Es wird abgebrochen", vbOKOnly, "AddIn-Updater"
Exit Sub
End If
Set fso = Nothing
End If
'Deinstalliere und lösche das alte AddIn
If deleteOld Then
'Deinstalliere das bestehende AddIn
AddIns(existingAddInName).Loaded = msoFalse
'Lösche die Datei
' AddIns(existingAddInName).Registered = msoFalse
AddIns(existingAddInName).Application.AddIns.Remove (existingAddInName)
'Lösche die Datei aus dem Ordner
' Kill AddInsPath & existingAddInName
End If
'Erstelle ein File System Object um das AddIn in den Standard-Ordner zu kopieren
Set fso = New FileSystemObject
'Kopiere die neue Datei in die Standard-AddIn-Bibliothek
'Call fso.CopyFile(source, destination[, overwrite])
fso.CopyFile desiredAddInFull, AddInsPath, True 'An dieser Stelle kommt der Fehler
'Füge das AddIn hinzu und installiere es
Set eai = Application.AddIns.Add(AddInsPath & desiredAddInName)
eai.Loaded = msoTrue
Set fso = Nothing
Presentations(potName).Close
Errorhandler:
If Not Err.Number = 0 Then
MsgBox "Error #" & Err.Number & vbCrLf _
& "Please, let Me know.", vbInformation
End If
End Sub