Forked from steve-jansen/ExportVisualBasicCode.bas.vb
Last active
February 11, 2019 07:57
-
-
Save pescara/e66a04bbe4217fde1b325a73eae2822d to your computer and use it in GitHub Desktop.
Excel macro to export all VBA source code in this project to text files for proper source control versioning.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
' Excel macro to export all VBA source code in this project to text files for proper source control versioning | |
' Requires enabling the Excel setting in Options/Trust Center/Trust Center Settings/Macro Settings/Trust access to the VBA project object model | |
' Im VBA muss Extras/Verweise/Microsoft Scripting Runtime aktiviert sein | |
Public Sub ExportVisualBasicCode() | |
Const Module = 1 | |
Const ClassModule = 2 | |
Const Form = 3 | |
Const Document = 100 | |
Const Padding = 24 | |
Dim VBComponent As Object | |
Dim count As Integer | |
Dim path As String | |
Dim directory As String | |
Dim extension As String | |
Dim fso As New FileSystemObject | |
directory = ActiveWorkbook.path & "\VisualBasic" | |
count = 0 | |
If Not fso.FolderExists(directory) Then | |
Call fso.CreateFolder(directory) | |
End If | |
Set fso = Nothing | |
For Each VBComponent In ActiveWorkbook.VBProject.VBComponents | |
Select Case VBComponent.Type | |
Case ClassModule, Document | |
extension = ".cls" | |
Case Form | |
extension = ".frm" | |
Case Module | |
extension = ".bas" | |
Case Else | |
extension = ".txt" | |
End Select | |
On Error Resume Next | |
Err.Clear | |
path = directory & "\" & VBComponent.name & extension | |
Call VBComponent.Export(path) | |
If Err.Number <> 0 Then | |
Call MsgBox("Failed to export " & VBComponent.name & " to " & path, vbCritical) | |
Else | |
count = count + 1 | |
Debug.Print "Exported " & Left$(VBComponent.name & ":" & Space(Padding), Padding) & path | |
End If | |
On Error GoTo 0 | |
Next | |
Application.StatusBar = "Successfully exported " & CStr(count) & " VBA files to " & directory | |
Application.Wait (Now + TimeSerial(0, 0, 10)) | |
Application.StatusBar = False | |
End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Kleine Änderung, damit alles einwandfrei läuft