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

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

 

[Trevor G]

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

Sub ExportMods()
' reference to extensibility library
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:\temp\" & objVBComp.Name & ".bas"
End If
Next
End Sub

 

[jamilm]

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

Dear Trevor,

the referred code you give me did not work. but thanks anyway

 

[Trevor G]

Dear Trevor,

the referred code you give me did not work. but thanks anyway

Yes it does, I think I didn't mention that you need to set the VBA Extension reference. In your workbook go into the VBA screen and Select the Tools Menu and References then search for Micrsoft Visual Basic For Applications Extensibility 5 and tick the box then you can run the code, I have tested no problems.

 

[jamilm]

Yes it does, I think I didn't mention that you need to set the VBA Extension reference. In your workbook go into the VBA screen and Select the Tools Menu and References then search for Micrsoft Visual Basic For Applications Extensibility 5 and tick the box then you can run the code, I have tested no problems.

thanks very much trevor. it worked now.

best regards,

Jamil

 

[Trevor G]

Your welcome Jamil and thanks for letting me know.

 

[jamilm]

Hi Trevor,

i found a VBA project uploaded in the given link belo, but not sure it gives an erro, could not figure out where the problem is, i was wondering if you could have a look into?

https://skydrive.live.com/redir?resid=D7C00A2BF29043E0!198

thanks.

best regards,

Jamil

 

[Trevor G]

I just downloaded the workbook and looked at the code and ran it and was prompted to select which workbook I wanted to output the VBA code for and selected the same workbook, then selected the location and added a file name, worked perfectly and I checked the file.

 

[jamilm]

I just downloaded the workbook and looked at the code and ran it and was prompted to select which workbook I wanted to output the VBA code for and selected the same workbook, then selected the location and added a file name, worked perfectly and I checked the file.

When i run it, it does not work for me, i get the error. i have uploaded the error screenshot in the given link below.

https://skydrive.live.com/redir?resid=D7C00A2BF29043E0!200

 

[Trevor G]

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