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

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

 

[jamilm]

Can you drop a copy of the workbook into skydrive then?

Yeah. It's the same file shared earlier here is the link https://skydrive.live.com/redir?resid=D7C00A2BF29043E0!198

 

[Trevor G]

This worked perfectly on my machine. Do you have any Add Ins that this doesn't like? Complete file it transfered to text is 365 line long I can send you the result if you need that, but I am sure you want it to work on your machine.

 

[jamilm]

many thanks Trevor. it worked the problem was that the path which i was selecting to save the module was network drive and once i changed it to local drive it worked.

you help is much appreciated.

best regards,

 

[Trevor G]

Jamilm please to read you have this working and thanks for letting me know.

 

[aamailhot]

Alternatively if you are like me and prefer to avoid early binding (using References), I believe Trevor's code could be ported into a late binding style (usable without checking that Reference box) as follows:

Sub ExportMods()             
 ' reference to extensibility library           
 Dim objMyProj As Object
 Dim objVBComp As Object
 Set objMyProj = Application.VBE.ActiveVBProject            
 For Each objVBComp In objMyProj.VBComponents          
 If objVBComp.Type = 1 Then              
 objVBComp.Export "C:\temp\" & objVBComp.Name & ".bas"          
 End If      
Next        
 End Sub

Note the three changes I made to the code: the two 'Dim' lines are now type 'Object' and the 'For each' line is now comparing to the literal value of 1. I recommend reading up on Early vs Late Binding as they both have their pros and cons.

Thanks so much for the nice Utility, Trevor G!

 

[Haluk]

---- Deleted ----

 

[aamailhot]

Thanks for the great utility Trevor. I think it is worth mentioning that this utility will only find 'standard' modules (which I take to be any module that shows up in the 'module' folder of the VBA project browser). I believe the OP was also looking for userforms and maybe class modules as well, in which case the user will have to expand the 'if' statement to do an OR-ing check of objVBComp.Type for the values of 'vbext_ct_ClassModule' or 'vbext_ct_MSForm', respectively. If the user modifies this utility to be late-binding (see my other post on this topic), these would be the literal values of 2 and 3, respectively. Full MS reference: https://msdn.microsoft.com/en-us/library/aa445236(v=vs.60).aspx

Hope that helps, thanks again.

 

[Haluk]

An alternative is; to write all the codes in each and every kind of module, to seperate *.txt files where the below code is running.

So, insert this code into a XL file and save it. Then, run the procedure below.

Sub Module_Codes_to_Text_File()
    Z = 1
    For Each Module In ThisWorkbook.VBProject.VBComponents
        Set VBCodeMod = ThisWorkbook.VBProject.VBComponents(Z).CodeModule
        Open ThisWorkbook.Path & Application.PathSeparator & "[" & Mid(ThisWorkbook.Name, 1, Len(ThisWorkbook.Name) - 4) & "] " & Module.Name & ".txt" For Output As #1
        With VBCodeMod
            NoLines = .CountOfLines
            For i = 1 To NoLines
                myLine = .Lines(i, 1)
                Print #1, myLine
            Next
            Close #1
        End With
    Z = Z + 1
    Next
End Sub

 

[aamailhot]

An alternative is; to write all the codes in each and every kind of module, to seperate *.txt files where the below code is running.

So, insert this code into a XL file and save it. Then, run the procedure below.

Sub Module_Codes_to_Text_File()
    Z = 1
    For Each Module In ThisWorkbook.VBProject.VBComponents
        Set VBCodeMod = ThisWorkbook.VBProject.VBComponents(Z).CodeModule
        Open ThisWorkbook.Path & Application.PathSeparator & "[" & Mid(ThisWorkbook.Name, 1, Len(ThisWorkbook.Name) - 4) & "] " & Module.Name & ".txt" For Output As #1
        With VBCodeMod
            NoLines = .CountOfLines
            For i = 1 To NoLines
                myLine = .Lines(i, 1)
                Print #1, myLine
            Next
            Close #1
        End With
    Z = Z + 1
    Next
End Sub

Thanks for the alternative, Haluk. I agree with your approach for the most part but had a few points that I wanted to pull the thread on some:

1. I would recommend not generating filenames with spaces in them, but it should in principle be safe enough. Likewise, I am not too sure about the bracket characters; perhaps an underline would be a better (more conventional) option?
2. What is your reasoning for saving the files as .txt vs .bas? I feel that the former is more intuitively a human-readable file, BUT (to my knowledge) VBA can only import the latter. You can also read .bas files directly (double-click to open in text editor), once you configure your machine to do so.
3. I note that this solution will truly give you ALL modules in the Project, including ones that are 'document modules'. Looks like these exist in the 'Microsoft Excel Objects' folder of the VBAProject and are generally associated with each "SheetX" in the user's workbook. I am not sure what the use of these are; I haven't used them myself and further it looks like you can't delete these modules other than deleting the associated sheet. Thus in my use case at least, this would result in my having a bunch of empty .txt files as I use a lot of sheets in my tool. In fullness, these document modules will show up as VBComponent.Type = vbext_ct_Document (or literal value 100, if you prefer).

 

[Haluk]

[*]What is your reasoning for saving the files as .txt vs .bas?

The first reason for creating text files is; because of the OP's original message. The header of the message says; VBA Macro to Export all VBA projects modules, user forms etc to seperate notepad or word.docx

On the other hand, the code above was a small part of an Excel Add-In i've written before (originally in year 2003). It was creating a right-click pop up menu in VBE's code window and some functions were assigned to it, to make users' life better.