Reset a profile

I have a default profile that gets updated every so often
Other users are useing this profile as well so I have created a macro to reload the profile. The thing I want to do is get the information for all the old menus, pulldowns and toolbars that the user has and after the profile is set reload and reset the menus, etc. I got to the menus part but am lost on how to do the rest.

Here is what I got so far:

Sub ResetProfile()
Dim objPrefProfiles As AcadPreferencesProfiles, preferences As AcadPreferences
Dim strProfileToImport As String, strMenu As Variant
Dim objMenus As New Collection, objMenu As AcadMenuGroup
Set objPrefProfiles = Application.preferences.Profiles

For Each objMenu In Application.MenuGroups
objMenus.Add objMenu.MenuFileName
Next objMenu

'If the profile is current set the default current
Debug.Print objPrefProfiles.ActiveProfile
If objPrefProfiles.ActiveProfile = "Gary2005" Then
objPrefProfiles.ActiveProfile = "<<Unnamed Profile>>"
End If


' Specify the profile to delete.
strProfileToImport = "Gary2005"

' Delete the profile
' The call will fail if "Gary2005" does not exist
On Error GoTo Error
objPrefProfiles.ImportProfile strProfileToImport, "D:\share\Gary2005.arg", True

'Set the profile current
objPrefProfiles.ActiveProfile = strProfileToImport

'Release the object pointer
Set objPrefProfiles = Nothing

'Reload any old menus not associated with the new profile
On Error Resume Next
For Each strMenu In objMenus
Application.MenuGroups.Load strMenu
Next strMenu

Exit Sub
Error:

 

Interesting.
Have you gotten any farther with this??
If so, could you please post what you've got?
In the meantime, I'm going to take a hack at it. This is something that I
could certainly use. Seems like I've always got to reset profiles around
here because people keep messing with things.

--
Matt W

I love deadlines
I like the whooshing sound they make as they fly by.

| I have a default profile that gets updated every so often
| Other users are useing this profile as well so I have created a macro to
reload the profile. The thing I want to do is get the information for all
the old menus, pulldowns and toolbars that the user has and after the
profile is set reload and reset the menus, etc. I got to the menus part but
am lost on how to do the rest.
|
| Here is what I got so far:
|
| Sub ResetProfile()
| Dim objPrefProfiles As AcadPreferencesProfiles, preferences As
AcadPreferences
| Dim strProfileToImport As String, strMenu As Variant
| Dim objMenus As New Collection, objMenu As AcadMenuGroup
| Set objPrefProfiles = Application.preferences.Profiles
|
| For Each objMenu In Application.MenuGroups
| objMenus.Add objMenu.MenuFileName
| Next objMenu
|
| 'If the profile is current set the default current
| Debug.Print objPrefProfiles.ActiveProfile
| If objPrefProfiles.ActiveProfile = "Gary2005" Then
| objPrefProfiles.ActiveProfile = "<<Unnamed Profile>>"
| End If
|
|
| ' Specify the profile to delete.
| strProfileToImport = "Gary2005"
|
| ' Delete the profile
| ' The call will fail if "Gary2005" does not exist
| On Error GoTo Error
| objPrefProfiles.ImportProfile strProfileToImport,
"D:\share\Gary2005.arg", True
|
| 'Set the profile current
| objPrefProfiles.ActiveProfile = strProfileToImport
|
| 'Release the object pointer
| Set objPrefProfiles = Nothing
|
| 'Reload any old menus not associated with the new profile
| On Error Resume Next
| For Each strMenu In objMenus
| Application.MenuGroups.Load strMenu
| Next strMenu
|
| Exit Sub
| Error: