Versions Compared

Key

  • This line was added.
  • This line was removed.
  • Formatting was changed.

https://www.rondebruin.nl/win/s9/win002.htm

https://stackoverflow.com/questions/69646560/is-there-any-way-to-export-a-custom-ribbon-stored-inside-an-xlsm-file

No Format
Public Sub Backup()

 Call ExportModules
 Call XLAM_Backup
 Call Git_Backup
 
End Sub
No Format
Public Sub Git_Backup()
    
    cmd = Environ("USERPROFILE") & "\Documents\VBAProjectFiles\git_push.cmd"
    Debug.Print "Running: " & cmd
    retval = Shell(cmd, vbNormalFocus)
    
End Sub
No Format
Public Sub XLAM_Backup()

 Dim BackupFolderStr As String, SevenZipExePathStr  'test
    As String
 BackupFolderStr = Environ("USERPROFILE") & "\Documents\VBAProjectFiles\"
 SevenZipExePathStr = "C:\Program_Files\7-Zip\App\7-Zip\7z.exe"
 
 Call ExtractXLAM(SevenZipExePathStr, BackupFolderStr)
End Sub
No Format
Public Sub ExportModules()
    Dim bExport As Boolean
    Dim wkbSource As Excel.Workbook
    Dim szSourceWorkbook As String
    Dim szExportPath As String
    Dim szFileName As String
    Dim cmpComponent As VBIDE.VBComponent

    ''' The code modules will be exported in a folder named.
    ''' VBAProjectFiles in the Documents folder.
    ''' The code below create this folder if it not exist
    ''' or delete all files in the folder if it exist.
    If FolderWithVBAProjectFiles = "Error" Then
        Debug.Print "Export Folder not exist"
        Exit Sub
    End If
    
    On Error Resume Next
        Kill FolderWithVBAProjectFiles & "\*.bas"
        Kill FolderWithVBAProjectFiles & "\*.cls"
        Kill FolderWithVBAProjectFiles & "\*.frm"
        Kill FolderWithVBAProjectFiles & "\*.frx"
    On Error GoTo 0

    ''' NOTE: This workbook must be open in Excel.
    szSourceWorkbook = ThisWorkbook.Name
    Set wkbSource = Application.Workbooks(szSourceWorkbook)
    
    If wkbSource.VBProject.Protection = 1 Then
    Debug.Print "The VBA in this workbook is protected," & _
        "not possible to export the code"
    Exit Sub
    End If
    
    szExportPath = FolderWithVBAProjectFiles & "\"
    
    For Each cmpComponent In wkbSource.VBProject.VBComponents
        
        bExport = True
        szFileName = cmpComponent.Name

        ''' Concatenate the correct filename for export.
        Select Case cmpComponent.Type
            Case vbext_ct_ClassModule
                szFileName = szFileName & ".cls"
            Case vbext_ct_MSForm
                szFileName = szFileName & ".frm"
            Case vbext_ct_StdModule
                szFileName = szFileName & ".bas"
            Case vbext_ct_Document
                ''' This is a worksheet or workbook object.
                ''' Don't try to export.
                bExport = False
        End Select
        
        If bExport Then
            ''' Export the component to a text file.
            cmpComponent.Export szExportPath & szFileName
            
        ''' remove it from the project if you want
        '''wkbSource.VBProject.VBComponents.Remove cmpComponent
        
        End If
   
    Next cmpComponent

    Debug.Print "Export is ready"
End Sub


No Format
Public Sub ImportModules()
    Dim wkbTarget As Excel.Workbook
    Dim objFSO As Scripting.FileSystemObject
    Dim objFile As Scripting.File
    Dim szTargetWorkbook As String
    Dim szImportPath As String
    Dim szFileName As String
    Dim cmpComponents As VBIDE.VBComponents

    If ActiveWorkbook.Name = ThisWorkbook.Name Then
        Debug.Print "Select another destination workbook" & _
        "Not possible to import in this workbook "
        Exit Sub
    End If

    'Get the path to the folder with modules
    If FolderWithVBAProjectFiles = "Error" Then
        Debug.Print "Import Folder not exist"
        Exit Sub
    End If

    ''' NOTE: This workbook must be open in Excel.
    szTargetWorkbook = ActiveWorkbook.Name
    Set wkbTarget = Application.Workbooks(szTargetWorkbook)
    
    If wkbTarget.VBProject.Protection = 1 Then
    Debug.Print "The VBA in this workbook is protected," & _
        "not possible to Import the code"
    Exit Sub
    End If

    ''' NOTE: Path where the code modules are located.
    szImportPath = FolderWithVBAProjectFiles & "\"
        
    Set objFSO = New Scripting.FileSystemObject
    If objFSO.GetFolder(szImportPath).Files.Count = 0 Then
       Debug.Print "There are no files to import"
       Exit Sub
    End If

    'Delete all modules/Userforms from the ActiveWorkbook
    Call DeleteVBAModulesAndUserForms

    Set cmpComponents = wkbTarget.VBProject.VBComponents
    
    ''' Import all the code modules in the specified path
    ''' to the ActiveWorkbook.
    For Each objFile In objFSO.GetFolder(szImportPath).Files
    
        If (objFSO.GetExtensionName(objFile.Name) = "cls") Or _
            (objFSO.GetExtensionName(objFile.Name) = "frm") Or _
            (objFSO.GetExtensionName(objFile.Name) = "bas") Then
            cmpComponents.Import objFile.Path
        End If
        
    Next objFile
    
    Debug.Print "Import is ready"
End Sub

No Format
Function FolderWithVBAProjectFiles() As String
    Dim WshShell As Object
    Dim FSO As Object
    Dim SpecialPath As String

    Set WshShell = CreateObject("WScript.Shell")
    Set FSO = CreateObject("scripting.filesystemobject")

    SpecialPath = WshShell.SpecialFolders("MyDocuments")

    If Right(SpecialPath, 1) <> "\" Then
        SpecialPath = SpecialPath & "\"
    End If
    
    If FSO.FolderExists(SpecialPath & "VBAProjectFiles") = False Then
        On Error Resume Next
        MkDir SpecialPath & "VBAProjectFiles"
        On Error GoTo 0
    End If
    
    If FSO.FolderExists(SpecialPath & "VBAProjectFiles") = True Then
        FolderWithVBAProjectFiles = SpecialPath & "VBAProjectFiles"
    Else
        FolderWithVBAProjectFiles = "Error"
    End If
    
End Function

No Format
Function DeleteVBAModulesAndUserForms()
        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        
        Set VBProj = ActiveWorkbook.VBProject
        
        For Each VBComp In VBProj.VBComponents
            If VBComp.Type = vbext_ct_Document Then
                'Thisworkbook or worksheet module
                'We do nothing
            Else
                VBProj.VBComponents.Remove VBComp
            End If
        Next VBComp
End Function
No Format
Public Sub ExtractXLAM(SevenZipExePathStr As String, BackupFolderStr As String)
    Dim wb As Workbook, FolderPathStr As String, SaveCopyPathStr As String
    Set wb = ThisWorkbook
    FolderPathStr = BackupFolderStr & wb.Name & "\"
    SaveCopyPathStr = FolderPathStr & wb.Name
    If (Dir(FolderPathStr, vbDirectory) <> "") = False Then MkDir (FolderPathStr)
    If (Dir(SaveCopyPathStr) <> "") = True Then Kill SaveCopyPathStr
    wb.SaveCopyAs SaveCopyPathStr

    Dim strShellString As String
    strShellString = "e " & Chr$(34) & SaveCopyPathStr & Chr$(34) & " -o" & Chr$(34) & FolderPathStr ' _
    ' & "\" & Chr$(34) & " customUI14.xml -r -aoa" ' Extract only CustomUI
                     
    Dim exePath As String
    exePath = Chr$(34) & SevenZipExePathStr & Chr$(34) & " "
    Debug.Print "Shell = " & exePath & strShellString

    Call Shell(exePath & strShellString)
    
End Sub