Excel macro question re code exporting 1

[larryww]

Being a red-blooded lazy programmer, whenever I need to do something new with macros, I "record" it and then imitate the produced code. But oops, I can't cheat this time because what I want to do is export code to a .BAS ... you can't "record" actions in the VBA window (AFAIK).

What is the Excel VBA code to export to .BAS? Can it prompt me for destination, like you get from ActiveWorkbook.SaveAs? And most of all, can it dynamically loop through each module, or through each worksheet's code (which normally is nothing)? [i.e. something like For Each sheet... and maybe For Each module...?!]

For what it's worth, I wrote other macros which will join this new one as a text documenter - one saves all values; one saves all formulas; one saves all range definitions; and now this one would save all code. Feel free to suggest others. (The goal is something I can text compare; .BAS export code qualifies. Too bad the whole file isn't text, like VB.)

TIA. I hope I'm not asking for a lot here.

 

[xlhelp]

Code courtsey Myrna Larson:

Option Explicit
Option Compare Text
Option Base 1

Sub ExportModules()
Dim sWBName As String
Dim OneFile As Boolean
Dim WB As Workbook
Dim WasOpen As Boolean

Application.ScreenUpdating = False

On Error Resume Next
sWBName = ActiveWorkbook.Name
Err.Clear

Do
sWBName = InputBox("Enter name of workbook to export", "EXPORT VB CODE", _
sWBName)
If sWBName = "" Then GoTo Done

Err.Clear
Set WB = Workbooks(sWBName)
WasOpen = Err.Number = 0
If WasOpen Then Exit Do

If MsgBox("This workbook is not open. Open it?", vbYesNo, "ERROR&quot _
= vbYes Then
Err.Clear
Application.EnableEvents = False
Set WB = Workbooks.Open(FileName:=sWBName)
Application.EnableEvents = True
If Err.Number = 0 Then Exit Do
MsgBox "Can't open this file. Re-enter the name.", vbOKOnly, "ERROR"
End If
Loop
On Error GoTo 0

If MsgBox("Write to a single file?", vbYesNo, "ONE FILE?&quot = vbYes Then
WriteCode_ WB
Else
ExportModules_ WB
End If

If WasOpen = False Then
If MsgBox("Close " & WB.Name & "?", vbYesNo + vbQuestion, _
"CLOSE FILE?&quot = vbYes Then
WB.Close SaveChanges:=False
End If
End If

Done:
Application.ScreenUpdating = True

End Sub 'ExportModules

Private Sub ExportModules_(WB As Workbook)
Dim objComp As VBComponent
Dim sModName As String
Dim sPath As String
Dim sFileName As String
Dim sExt As String

sPath = WB.Path
For Each objComp In WB.VBProject.VBComponents
sModName = objComp.Name
Select Case objComp.Type
Case vbext_ct_StdModule: sExt = ".Bas"
Case vbext_ct_ClassModule: sExt = ".Cls"
Case vbext_ct_MSForm: sExt = ".Frm"
End Select

sFileName = sPath & "\" & sModName & sExt
If Len(Dir$(sFileName)) > 0 Then
Kill sFileName
End If
objComp.Export FileName:=sFileName
Next objComp

End Sub

Private Sub WriteCode_(WB As Workbook)
Dim CRs As String
Dim sPath As String
Dim sFileName As String
Dim F As Integer
Dim objComp As VBComponent
Dim sModName As String
Dim sTemp As String, N As Long

CRs = vbCrLf & vbCrLf

sPath = WB.Path
sFileName = WB.Name
F = InStr(sFileName, ".&quot
If F Then
sFileName = Left$(sFileName, F) & "Cod"
Else
sFileName = sFileName & ".Cod"
End If

F = FreeFile
Open sPath & "\" & sFileName For Output As #F
For Each objComp In WB.VBProject.VBComponents
With objComp
With .CodeModule
N = .CountOfLines
If N Then sTemp = .Lines(1, N)
End With

If N Then
N = Len(sTemp)
Do While N
If Asc(Mid$(sTemp, N, 1)) > 32 Then Exit Do
N = N - 1
Loop

If N > 0 Then
Print #F, UCase$(.Name) & " CODE***"
Print #F,
Print #F, Left$(sTemp, N);
Print #F, CRs
End If
End If
End With
Next objComp
Close #F
End Sub

 

[larryww]

xlh that looks fantastic - I will have to set it aside for just now but will advise if any hickups arise.

 

[larryww]

Way to go! That's it.

It did need a really difficult, nearly impossible to find Tools/Reference (way to go Microsoft, you clueless fools). Chip Pearson saved me in

http://www.cpearson.com/excel/vbe.htm

(I predict Gates will next have them place Automatic Recalc under Microsoft DAO 3.6 Object library, rendering all spreadsheets in the Northern Hemisphere as non compilable.)[rant mode off]

So a recommended addition (attention: any coders for Addins) is a line such as
'TO USE THIS you MUST check "Tools/Reference/Microsoft Visual Basic For Applications Extensibility"

I also tweaked in a couple of booleans and msgboxes for safety with the "kill" part.

I did note one difference between manually exporting (a .BAS) and using this (to a .COD file): the .BAS also noted attributes, such as shortcut keys on macros, and .COD didn't.

But this is exactly what I wanted. Thank you very, very much.