VBA Macro to Export all VBA projects modules, user forms etc to seperate notepad or word.docx

[jamilm]

Dear Friends and Colleagues,

i have the following VBA code that generates a summary of the vba projects for a workbook into another workbook. however i want help in modification of this code or perhaps another code to export all vba projects for a workbook into a notepad or word document.


any help will be greatly appreciated.

thanks.
----------------------
Option Explicit
Private Type ProcData
ModName As String
DecLine As String
Start As Long
NumLines As Long
End Type
Private Sub UserForm_Initialize()
Me.Caption = APPNAME
If GetSetting(PUPNAME, "Settings", "RememberSettings", 1) = 1 Then
cbFormControls.Value = GetSetting(PUPNAME, APPNAME, "cbFormControls", True * -1)
End If
' Select active workbook, if possible
On Error Resume Next
ListBox1.Value = ActiveWorkbook.Name
On Error GoTo 0
End Sub
Private Sub OKButton_Click()
Dim c 'As VBComponent
Dim cm 'As CodeModule
Dim UserSheets As Long
Dim r As Long
Dim CodeLines As Long, i As Long
Dim CurrLine As String
Dim Des 'As Designer
Dim ctl As Control
Dim OutputRow As Long
Dim Startline As Long
Dim Cnt As Long
Dim WkBook As String
Dim k As Long

WkBook = ListBox1.Value
' Exit if project is protected
If Workbooks(WkBook).VBProject.Protection Then
MsgBox "The VB Project for " & Workbooks(WkBook).Name & " is protected.", vbCritical, APPNAME
Exit Sub
End If

' Add a workbook
Application.ScreenUpdating = False
UserSheets = Application.SheetsInNewWorkbook
If cbFormControls Then Application.SheetsInNewWorkbook = 2 Else Application.SheetsInNewWorkbook = 1
Workbooks.Add
Application.SheetsInNewWorkbook = UserSheets

' Write the headings
Sheets(1).Activate
Sheets(1).Name = "Procedures"
With Range("A1")
.Value = "VBProject: " & Workbooks(WkBook).VBProject.Name & " (" & Workbooks(WkBook).Name & ")"
.Font.Size = 14
.Font.Bold = True
End With
With Range("A2")
.Value = "Report Generated " & Now
.Font.Italic = True
End With
With Range("A4:F4")
.Value = Array("VB Component", "Component Type", "Procedure Type", "Start Line", "Total Lines", "Procedure Declaration")
On Error Resume Next
.Font.Bold = True
.ColumnWidth = 40
.Columns.AutoFit
.Interior.ThemeColor = xlThemeColorLight2
.Interior.TintAndShade = 0.8
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
On Error GoTo 0
End With
' Loop through the components
r = 4
k = 0
For Each c In Workbooks(WkBook).VBProject.vbComponents
Dim Procedures() As ProcData
Set cm = c.CodeModule
Cnt = 0
CodeLines = c.CodeModule.CountOfLines
' Loop through the procedures
With cm
Startline = .CountOfDeclarationLines + 1
Do Until Startline >= .CountOfLines
Cnt = Cnt + 1
ReDim Preserve Procedures(1 To Cnt)
Procedures(Cnt).ModName = .ProcOfLine(Startline, k)
Procedures(Cnt).Start = .ProcBodyLine(Procedures(Cnt).ModName, k)
Procedures(Cnt).DecLine = .Lines(Procedures(Cnt).Start, 1)
Procedures(Cnt).NumLines = .ProcCountLines(Procedures(Cnt).ModName, k)
Startline = Startline + Procedures(Cnt).NumLines
Loop
End With

' write data to the sheet
If Cnt = 0 Then ' no procedures
r = r + 1
Cells(r, 1) = c.Name
Cells(r, 2) = CodeModuleType(c)
Cells(r, 3) = "(no procedures)"
Cells(r, 4) = ""
Cells(r, 5) = ""
Cells(r, 6) = ""
Else
For i = 1 To Cnt
r = r + 1
Cells(r, 1) = c.Name
Cells(r, 2) = CodeModuleType(c)
Cells(r, 3) = Procedures(i).ModName
Cells(r, 4) = Procedures(i).Start
Cells(r, 5) = Procedures(i).NumLines
Cells(r, 6) = Procedures(i).DecLine
Next i
End If
Next c
' Adjust column widths of output sheet
Range("A4:G100").Columns.AutoFit
' Do UserForm controls?
If cbFormControls Then
Sheets(2).Activate
Sheets(2).Name = "UserForm Controls"
Else
Unload Me
Exit Sub
End If
' Write headings
With Range("A1")
.Value = "VBProject: " & Workbooks(WkBook).VBProject.Name & " (" & Workbooks(WkBook).Name & ")"
.Font.Size = 14
.Font.Bold = True
End With
With Range("A2")
.Value = "UserForm Report Generated " & Now
.Font.Italic = True
End With
With Range("A4:H4")
.Value = Array("UserForm Name", "Control Type", "Control Name", "Left", "Top", "Width", "Height", "Container")
On Error Resume Next
.Font.Bold = True
.Interior.ThemeColor = xlThemeColorLight2
.Interior.TintAndShade = 0.8
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
On Error GoTo 0
End With
r = 4
For Each c In Workbooks(WkBook).VBProject.vbComponents
If c.Type = 3 Then 'UserForm
CurrLine = r
Set Des = c.Designer
For Each ctl In Des.Controls
r = r + 1
Cells(r, 1) = c.Name
Cells(r, 2) = TypeName(ctl)
Cells(r, 3) = ctl.Name
Cells(r, 4) = ctl.Left
Cells(r, 4).NumberFormat = "0.00"
Cells(r, 5) = ctl.Top
Cells(r, 5).NumberFormat = "0.00"
Cells(r, 6) = ctl.Width
Cells(r, 6).NumberFormat = "0.00"
Cells(r, 7) = ctl.Height
Cells(r, 7).NumberFormat = "0.00"
Cells(r, 8) = ctl.Parent.Name
Next ctl
If CurrLine = r Then
r = r + 1
Cells(r, 1) = c.Name
Cells(r, 2) = "(no controls)"
End If
End If
Next c
Range("A4:H100").Columns.AutoFit
Sheets(1).Activate
SaveSetting PUPNAME, APPNAME, "cbFormControls", cbFormControls.Value * -1
Unload Me
Application.ScreenUpdating = True
End Sub
Function CodeModuleType(cm)
Select Case cm.Type
Case 1: CodeModuleType = "Standard Module"
Case 2: CodeModuleType = "Class Module"
Case 3: CodeModuleType = "Form"
Case 11: CodeModuleType = "Designer"
Case 100: CodeModuleType = "Document Module"
Case Else: CodeModuleType = "Unknown"
End Select
End Function


Private Sub CancelButton_Click()
Unload Me
End Sub

--------------------------

 

[Bneder]

Hello, can someone help me edit this code pls ?
I need export my macros only from PERSONAL.XLSB

Sub A_00_TEST()

'On Error GoTo ERR
'Application.ScreenUpdating = False




    ' reference to extensibility library
    'Micrsoft Visual Basic For Applications Extensibility 5


    Dim objMyProj As VBProject
    Dim objVBComp As VBComponent


    Set objMyProj = Application.VBE.ActiveVBProject


    For Each objVBComp In objMyProj.VBComponents
        If objVBComp.Type = vbext_ct_StdModule Then
            objVBComp.Export "C:\Users\danie\Desktop\test\" & objVBComp.Name & Format(Now(), "  dd.mm.yyyy  (hh_mm_ss)") & ".txt"
        End If
    Next
    
    
ERR:
'Application.ScreenUpdating = True

End Sub

 

[rlv01]

One way

Sub A_00_TEST()

'On Error GoTo ERR
'Application.ScreenUpdating = False
    
    ' reference to extensibility library
    'Micrsoft Visual Basic For Applications Extensibility 5

    Dim objMyProj As VBProject
    Dim objVBComp As VBComponent
    Dim ExportFileName As String

    For Each objMyProj In Application.VBE.VBProjects
        With objMyProj
            If InStr(1, .Filename, "\PERSONAL.", vbTextCompare) > 0 Then
                Exit For
            End If
        End With
    Next objMyProj

    If Not objMyProj Is Nothing Then
        For Each objVBComp In objMyProj.VBComponents
            If objVBComp.Type = vbext_ct_StdModule Then
                ExportFileName = "C:\Users\danie\Desktop\test\" & objVBComp.Name & Format(Now(), "  dd.mm.yyyy  (hh_mm_ss)") & ".bas"
                objVBComp.Export ExportFileName
            End If
        Next
    End If
    
ERR:
    'Application.ScreenUpdating = True
End Sub

 

[Bneder]

Thx for the quick reply it helped me a lot. When i export / backup to text file, in first line i get this "Attribute VB_Name = "Module1", but i can edit this with another macro.

Problem solved.

 

[rlv01]

Attribute VB_Name = "Module1"

All exported code modules will have that. It is so when the file is imported, the code module name is set correctly.

 

[KentBurel]

Something like this should work, if you export them as modules you can always select to open them with either NotePad or Word

What do I need to do so that instead of each module being written to a separate file, I want to create a single word .docx file where each module becomes a separate header?