Hallo Zusammen,
mit dem folgenden Code lösche ich Vorlagenblätter aus meinen Projekten und ersetze diese mit den aktuellen.
Sub UpdateSheets()
Dim oProjectSelection As ObjectItem
Dim oProject As Project
Dim oTempSheets As ObjectItems
Dim oActProject As Project
Dim oSheet As ObjectItem
Dim oPath As ObjectItem
Dim bFirstRun As Boolean
For Each oProjectSelection In
Application.Selection
bFirstRun = False
Set oProject =
Application.Folders.ProjectTemplates.FindObjects(aucObjProject, aucSearchHierarchical, 0, aucAttrDesignation, aucCondEqual, cPrjName)(1)
Set oTempSheets = oProject.TemplatesFolder.FindObjects(aucObjSheet, aucSearchHierarchical)
Set oActProject = oProjectSelection '
Application.Selection(1)
For Each oSheet In oActProject.TemplatesFolder.FindObjects(aucObjSheet, aucSearchHierarchical)
If Not bFirstRun Then
bFirstRun = True
Set oPath = oSheet.Parent
End If
oSheet.Delete
Next
'If Not bFirstRun Then
' bFirstRun = True
' Set oPath = oActProject.TemplatesFolder.Kind
' FindObjects(aucObjFavoriteForms, aucSearchDeep, , , , "Favoriten"
'End If
For Each oSheet In oTempSheets
oSheet.CopyTo oPath, True
Next
RecycleBin
Next
End Sub
Das Problem ist:
Das wenn ich keine Blätter in den Vorlagen abgelegt habe funtioniert folgende Codezeilen nicht:
For Each oSheet In oActProject.TemplatesFolder.FindObjects(aucObjSheet, aucSearchHierarchical)
If Not bFirstRun Then
bFirstRun = True
Set oPath = oSheet.Parent
End If
Somit habe ich versucht mit folgendem Codezeilen den Pfad direkt zu setzen:
'If Not bFirstRun Then
' bFirstRun = True
-> ' Set oPath = oActProject.TemplatesFolder.Kind
-> ' FindObjects(aucObjFavoriteForms, aucSearchDeep, , , , "Favoriten"
'End If
Hier habe ich aber einen Fehler / alle was ich versuch führt nicht zum gewünschten Ergebeniss.
Achtung: Makro funktioniert sonst prima.
Kann mir da jemand helfen?