CODEWITHSUNDEEP
vbaexcel
yoshiserry
yoshiserry

Reputation: 21345

extract excel vba macros from excel files programatically

I have many excel macros I have written over the years and I would like to compile them into one document or module containing the functions I most frequently use (written very modular and reusable by others).

Anyone know how to programatically access the excel vba modules using vba or some other automation?

Upvotes: 0

Views: 6017

Answers (3)

Bill Early
Bill Early

Reputation: 181

This is my version of brettdj's code for plodding through word documents. The idea is to use something like WinMerge to compare successive versions afterwards.

This version runs in Excel, but operates on Word documents. (Excel is a far better and a more permissive VBA environment than Word). Be sure to have a reference of "Microsoft Word 16.0 Object Library" (or whatever version you have) in your project references.

The other difference is that in this example, it expects a clean "Dump" subdirectory then creates subdirectories for every set of files generated from every document. Note there are also .frm files which not entirely readable with casual text editors.

Option Explicit

Public Sub GetCode()
    Dim Doc As Word.Document
    Dim VBProj
    Dim VBComp
    Dim dir1 As String: dir1 = "C:\Users\Ralph\AppData\Roaming\Microsoft\Word\STARTUP\"
    Dim dir2 As String: dir2 = "C:\Users\Ralph\AppData\Roaming\Microsoft\Word\STARTUP\Dump\"
    Dim dir3 As String
    Dim file As String
    Dim fn As String
    Dim n As String

    If Len(Dir(dir2, vbDirectory)) = 0 Then MkDir dir2
    file = Dir(dir1 & "*.dotm")
    ' Application.ScreenUpdating = False
    ' Application.EnableEvents = False

    Do While Len(file) > 0
        Set Doc = Word.Documents.Open(dir1 & file, False)
        Set VBProj = Doc.VBProject
            For Each VBComp In VBProj.vbcomponents
                If VBComp.codemodule.countoflines > 0 Then
                    dir3 = dir2 & Replace(file, ".dotm", "") ' new subdirectory, get rid of .dotm
                    On Error Resume Next
                    MkDir dir3
                    On Error GoTo 0
                    n = VBComp.Name
                    fn = dir3 & "\" & n & ".txt"  ' the actual file name
                    VBComp.Export fn  ' exports the code and (pesky) .frx files
                End If
            Next
        Doc.Close False
    file = Dir
    Loop

    ' Application.ScreenUpdating = True
    ' Application.EnableEvents = True

End Sub

Upvotes: 0

brettdj
brettdj

Reputation: 55682

This code

  • Opens all xlsm files in a directory specififed by StrDir (C:\temp in this example)
  • Exports each code component to a second directory specified by StrDir2 (C:\mycode) if there is at least one line of code in that module

code

Sub GetCode()
Dim WB As Workbook
Dim VBProj
Dim VBComp
Dim StrDir As String
Dim StrDir2 As String
Dim StrFile As String

StrDir = "c:\temp\"
StrDir2 = "c:\mycode\"

If Len(Dir(StrDir2, vbDirectory)) = 0 Then MkDir StrDir2
StrFile = Dir(StrDir & "*.xlsm")

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Do While Len(StrFile) > 0
    Set WB = Workbooks.Open(StrDir & StrFile, False)
    Set VBProj = WB.VBProject
        For Each VBComp In VBProj.vbcomponents
            If VBComp.codemodule.countoflines > 0 Then VBComp.Export StrDir2 & StrFile & "_" & VBComp.Name & ".txt"
        Next
    WB.Close False
StrFile = Dir
Loop

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

End Sub

Upvotes: 3

Gary's Student
Gary's Student

Reputation: 96753

The topic is well-covered here:

Pearson's Programming The VBA Editor

Upvotes: 2

Related Questions