The major and minor version of an office application can be found using Application.Version.
Return examples:
15.0 = Office 2013
12.0 = Office 2007
I require the revision and build version of the office application, example:
Microsoft Office PowerPoint 2007 Original: major.minor: 12.0 revision.build: 4518.1014
Microsoft Office PowerPoint 2007 SP2: major.minor: 12.0 revision.build: 6425.1000
Question: Is there a way of finding the revision and build version of an office application, using VBA?
Question updated: Naming convention mistake on my side - Looking for the revision and build version of an office application, not the minor version.
VBA does not have a function to do it directly, you will have to write a function to do it:
Public Sub test()
Dim version As String
Dim chkref As Object
' List of references
For Each chkref In ThisWorkbook.VBProject.References
version = RetrieveDllVersion(chkref.fullpath)
major = RetrievePart(version, 0)
majorup = RetrievePart(version, 1)
minor = RetrievePart(version, 2)
minorup = RetrievePart(version, 3)
MsgBox chkref.Name & " : " & major & "." & majorup & "." & minor & "." & minorup
Next
End Sub
Private Function RetrieveDllVersion(ByVal dll As String) As String
Dim fso As Object 'Scripting.FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
RetrieveDllVersion = fso.GetFileVersion(dll)
End Function
Private Function RetrievePart(ByVal version As String, ByVal pos As Integer) As String
RetrievePart = Split(version, ".")(pos)
End Function
Filter Excel / Office / Word on the chkref.name
Summary of alternatives :
Application.Version "16.0"
Application.Build "16.0.8431"
Application.BuildFull "16.0.8431.0"
CreateObject("Scripting.FileSystemObject") _
.GetFileVersion(Application.Path & "\WINWORD.exe") "16.0.8431.2280"
Related
I have a macro-enabled presentation that aims to use an InsertFromFile command to copy a single slide from each of a number of other target presentations held in the same SharePoint location into the master.
The code seems to draw the slide from some previous version of the target presentation. Getting the code to open the target presentation before giving the InsertFromFile command still only gets the slides from a more recent version, not the most recent version.
The SharePoint library uses major and minor versions, but it doesn't look like the most recent major version is used.
I am looking for a way for VBA to ensure that the InsertFromFile command (or an alternative method) gets the slides from the most recent version, major or minor, of the target presentations.
The SharePoint site is associated with Teams (although I always use SharePoint directly).
Option Explicit
Sub Consolidate()
Dim pptTMOReport As Presentation
Dim strCharterReport As String
Dim strFolderPath As String
Dim intCharter As Integer
Dim intSlideCount As Integer
'Set variables
Set pptTMOReport = ActivePresentation
strFolderPath = pptTMOReport.Path
'Remove previous Charter Report slides
If pptTMOReport.Slides.Count <= 3 Then GoTo CheckCharter
intSlideCount = pptTMOReport.Slides.Count - 3
For intCharter = 1 To intSlideCount
If pptTMOReport.Slides.Count <= 3 Then Exit For
pptTMOReport.Slides(pptTMOReport.Slides.Count - 1).Delete
Next intCharter
CheckCharter:
For intCharter = 1 To 6 'Cycle 6 times (there are 6 target presentations)
strCharterReport = strFolderPath & "/Charter " & intCharter & " Report.pptx"
pptTMOReport.Slides.InsertFromFile strCharterReport, pptTMOReport.Slides.Count - 1, 2, 2 'Insert slide 2 from the target presentation as the second last slide in the master
Next intCharter
pptTMOReport.Slides(1).Shapes("txtDate").TextFrame.TextRange.Text = "Updated " & Format(Now, "d MMMM yyyy hh:mm")
pptTMOReport.SlideMaster.Shapes("txtDate").TextFrame.TextRange.Text = "Updated " & Format(Now, "dd/mm/yyyy")
End Sub
MS Word 2010 has a bug in its ability to correctly maintain (of all things) the documents collection (link to earliest report found - social.msdn.microsoft.com).
As far as I can tell this bug only impacts Word 2010. Although the documents collection is not maintained, it turns out that the Application.Windows collection is. Hence, for Word 2010 the following code based on the original reporters investigation (see below) and this question on answers.microsoft.com seem to provide a good alternative to the buggy documents collection:
' PURPOSE:
' Return a document collection, work-around for Word 2010 bug
Public Function docCollection() As VBA.Collection
Dim indexOfAvailableAppWindows As Long
Dim resultDoc As VBA.Collection
Dim foundDoc As Word.Document
Set resultDoc = New Collection
For indexOfAvailableAppWindows = 1 To Application.Windows.Count
If Application.Windows(indexOfAvailableAppWindows).Document.Type = wdTypeDocument Then
Set foundDoc = Application.Windows(indexOfAvailableAppWindows).Document
resultDoc.Add foundDoc, foundDoc.FullName ' Can NOT use 'name' - fails to be unique
End If
Next indexOfAvailableAppWindows
Set docCollection = resultDoc
Set resultDoc = Nothing
End Function
However, and here's my question, the above code some times fails with error 457 This key is already associated with an element of this collection on line resultDoc.Add foundDoc, foundDoc.FullName. What circumstances could possibly lead to such a failure?
So far the code has only failed on 1 PC running Word 2016. I don't have access to the PC. I did discover that the original version used Document.Name as the key (which was not always unique, so this was changed to Document.Full name)
Assumptions:
Document.FullName will always be unique
Things I've ruled out:
use of Split Window
opening downloaded documents (protected window documents are not counted)
Code that can be used to demonstrate the issue in Word 2010 (adapted from the original report).
' Function Credit Bas258 (https://social.msdn.microsoft.com/profile/bas258)
Function test01() As Boolean
'Adapted to VBA from original: 03-11-2012 1.0 Visual Studio 2008 VB code
Dim oDoc As Word.Document
Dim oDoc0 As Word.Document
Dim oDoc1 As Word.Document
Dim oDoc2 As Word.Document
Dim oDoc3 As Word.Document
Dim oDoc4 As Word.Document
Dim n As Integer
Set WDapp = Application
With WDapp
Debug.Print (Format(Now(), "dd-MM-yyyy") & " MS Office " & .Application.Version)
Set oDoc0 = .Documents.Add: Debug.Print ("add " & oDoc0.Name)
Set oDoc1 = .Documents.Add: Debug.Print ("add " & oDoc1.Name)
Set oDoc2 = .Documents.Add: Debug.Print ("add " & oDoc2.Name)
Set oDoc3 = .Documents.Add: Debug.Print ("add " & oDoc3.Name)
Set oDoc4 = .Documents.Add: Debug.Print ("add " & oDoc4.Name)
For n = 1 To .Documents.Count
Debug.Print ("count " & n & " " & .Documents(n).Name)
Next n
Debug.Print ("close " & oDoc4.Name)
oDoc4.Close
Set oDoc4 = Nothing
Debug.Print ("close " & oDoc3.Name)
oDoc3.Close
Set oDoc3 = Nothing
For n = 1 To .Documents.Count
Debug.Print ("count " & n & " " & .Documents(n).Name)
Next n
n = 0
For Each oDoc In .Documents
n = n + 1
Debug.Print ("doc " & n & " " & oDoc.Name)
Next oDoc
n = 0
For Each oWin In .Windows
n = n + 1
Debug.Print ("win " & n & " " & oWin.Document.Name)
Next oWin
Debug.Print ("close " & oDoc2.Name)
oDoc2.Close
Set oDoc2 = Nothing
Debug.Print ("close " & oDoc1.Name)
oDoc1.Close
Set oDoc1 = Nothing
Debug.Print ("close " & oDoc0.Name)
oDoc0.Close
Set oDoc0 = Nothing
End With
Set WDapp = Nothing
End Function
This is NOT going to be the accepted answer. Although it does answer the broader question (what could cause this code to crash) it not address the specific crash that I am trying to isolate. Either way there appears to be another bug in MS Word which seemed to be worth capturing for the common good.
This time the bug is with the Windows Collection; and joy of joys, I've confirmed it for both Word 2010 and Word 2016 - both 64 bit apps.
Steps to reproduce the bug are as follows:
In windows explorer enable the Preview Pane
Select a word document FILE so that it is 'previewed'
Open the same document (without losing the 'preview view')
Run the code from the OP, it will crash on this line:
If Application.Windows(indexOfAvailableAppWindows).Document.Type = wdTypeDocument Then
It turns out that when a word file is being previewed the Application.Windows.Count property is incremented by the preview; however any attempt to get a property of that window results in Error 5097 - Word has encountered a problem.
So, an improvement to the original code would therefore be:
' PURPOSE:
' Returns a healthy document collection
' - work-around for Word 2010 bug
' - excludes hits from Windows Explorer Preview Pane
Public Function docCollection() As VBA.Collection
On Error GoTo docCollectionError
Dim indexOfAvailableAppWindows As Long
Dim resultDoc As VBA.Collection
Dim foundDoc As Word.Document
Set resultDoc = New Collection
' Use index instead of Each to avoid For Loop Not initialised error, preview pane
For indexOfAvailableAppWindows = 1 To Application.Windows.Count
If Application.Windows(indexOfAvailableAppWindows).Document.Type = wdTypeDocument Then
Set foundDoc = Application.Windows(indexOfAvailableAppWindows).Document
resultDoc.Add foundDoc, foundDoc.FullName ' Key must NOT be 'name' - fails to be unique see BUG: 1315
End If
lblSkipThisDoc:
Next indexOfAvailableAppWindows
Set docCollection = resultDoc
Set resultDoc = Nothing
Exit:
Exit Function
docCollectionError:
If Err.Number = 5097 Then ' An open document is also open in the Windows Explorer Preview Pane
Err.Clear
Resume lblSkipThisDoc ' - skip this window
End If
If Err.Number = 457 Then ' Key is already used, but HOW? Unknown cause of error
Err.Clear
Stop 'Resume lblSkipThisDoc ' Is it safe to skip this document, why is there a duplicate?
End If
End Function
There is a setting in MS Word that enables 1 document to be viewed in 2 windows. In Word 2010 it is under the View (Tab): Window > New Window
The new window is counted separately in Application.Windows.Count and returns the same document object, hence the key exists.
For indexOfAvailableAppWindows = 1 To Application.Windows.Count ' <<< New Windows is counted
If Application.Windows(indexOfAvailableAppWindows).Document.Type = wdTypeDocument Then
Set foundDoc = Application.Windows(indexOfAvailableAppWindows).Document
resultDoc.Add foundDoc, foundDoc.FullName ' <<< fails to add 2nd instance of document
End If
So... the solution would likely involve checking the caption of the document:
IMMEDIATE WINDOW:
?foundDoc.Windows(1).Caption
Document2:1
I am looking to develop a basic com add-in for Office 2016 (perhaps globally for some of the other office apps - most likely, Excel, Word, PowerPoint, Publisher & OneNote) but in this instance for Outlook 2016 and specifically to add an 'Insert from Scanner" function to the "Microsoft.Outlook.Mail.Compose" Inspector Ribbon in a custom group ("Scanner's & Cameras") on it's "Insert" Tab.
This is my first VSTO com add-in project and I am new to code (but a willing learner!). My extensive research has gleaned little in step-by-step advice but I have identified the following code sample from microsoft
https://code.msdn.microsoft.com/office/VBOutlookRibbonXml-bc478854 which I had hoped to adapt (perhaps utilising the following 'scan' function vb code):
Private Declare PtrSafe Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Function TempPath() As String
Const MaxPathLen = 256 ' Max length of the path, just as big as possible
Dim FolderName As String ' Name of the folder
Dim ReturnVar As Long ' Return Value
FolderName = String(MaxPathLen, 0)
ReturnVar = GetTempPath(MaxPathLen, FolderName)
If ReturnVar <> 0 Then
TempPath = Left(FolderName, InStr(FolderName, Chr(0)) - 1)
Else
TempPath = vbNullString
End If
End Function
Sub Scan(control As IRibbonControl)
Const olEditorWord = 4
Dim objCommonDialog As WIA.CommonDialog
Dim objImage As WIA.ImageFile
Dim strDateiname As String
Dim ActiveObject As Object, ActiveTarget As Object
' instantiate Scan WIA objects
Set objCommonDialog = New WIA.CommonDialog
Set objImage = objCommonDialog.ShowAcquireImage
strDateiname = Environ$("TEMP") & "\Scan.jpg" ' set temporary file
If Not objImage Is Nothing Then
If Dir(strDateiname) <> "" Then Kill strDateiname
objImage.SaveFile strDateiname 'save into temp file
DoEvents
'Insert the picture into the office application:
Select Case Trim$(Replace$(Application.Name, "Microsoft", ""))
Case "Excel"
Set ActiveObject = CallByName(Application, "ActiveSheet", VbGet)
Set ActiveTarget = CallByName(Application, "ActiveCell", VbGet)
If ActiveTarget Is Nothing Then
'Insert into a chart, etc.
ActiveObject.Shapes.AddPicture _
strDateiname, False, True, 0, 0, -1, -1
Else
'Insert into a sheet at the active cell
ActiveObject.Shapes.AddPicture _
strDateiname, False, True, ActiveTarget.Left, ActiveTarget.Top, -1, -1
End If
Case "Outlook"
Set ActiveObject = CallByName(Application, "ActiveInspector", VbGet)
If ActiveObject Is Nothing Then
MsgBox "Create a new mail and try again"
Exit Sub
End If
With ActiveObject
If .IsWordMail And .EditorType = olEditorWord Then
.WordEditor.Application.Selection.InlineShapes.AddPicture strDateiname
End If
End With
Case "PowerPoint"
Set ActiveObject = CallByName(ActiveWindow, "View", VbGet)
ActiveObject.Slide.Shapes.AddPicture strDateiname, False, True, 0, 0, -1, -1
Case "Publisher"
Set ActiveObject = CallByName(Application, "ActiveDocument", VbGet)
ActiveObject.ActiveView.ActivePage.Shapes.AddPicture strDateiname, False, True, 0, 0, -1, -1
Case "Word"
Set ActiveObject = CallByName(Application, "Selection", VbGet)
ActiveObject.InlineShapes.AddPicture strDateiname
End Select
End If
End Sub
Unfortunately the above Microsoft Office Development Centre Sample code is for Office 2010 and VS 2010 and so can't be accessed.
How can I adapt the sample for use with Office (Outlook) 2016 and VS 2015?
Can the above VB code block be inserted (as written) to replace the code of one the test buttons on the sample, or will it require adapting further?
You can simply copy the classes in the sample project into your VS 2015 project. The sample project is using a project template for a version of Office that VS 2015 doesn't support, and the Interop references would be different as well.
If you're looking to add a custom Ribbon button, just add a Ribbon (Visual Designer) item (or Ribbon (XML) item) from the Office/SharePoint node in the Add New Item dialog.
I wanna check the window version on different comp thus to do different task on MS word 2007 vba. i tried this code which i applied on ms excel 2007 vba and is working, but not on MS word 2007 vba.
Dim TheOS As String
Dim WinType As String
TheOS = Application.OperatingSystem
MsgBox ("TheOS ")
On the ms word 2007 vba, it reurn a compile error:method or data member not found. what do i need?
If you want vba code that can be used all over the office products WMI is one solution.
The thing with Application.System.OperatingSystem that its not returning anything interesting.
Application.System.Version is usable. But I use the WMI to give me the correct information.
Sub test()
Dim info As System
'Well everything is windows NT today..
Debug.Print Application.System.OperatingSystem
'Short version string MajorVersion.MinorVersion
Debug.Print Application.System.Version
Dim objWMI As Object
Dim objSystems As Object
Dim objOs As Object
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set objSystems = objWMI.ExecQuery("Select * from Win32_OperatingSystem")
For Each objOs In objSystems
Debug.Print objOs.Name 'Full name as in OS startup screen
Debug.Print objOs.Caption ' Human readable name
Debug.Print objOs.Version ' the correct windows version string
Next
Set objOs = Nothing
Set objSystems = Nothing
Set objWMI = Nothing
End Sub
I'd like to be able to source control my Excel spreadsheet's VBA modules (currently using Excel 2003 SP3) so that I can share and manage the code used by a bunch of different spreadsheets - and therefore I'd like to re-load them from files when the spreadsheet is opened.
I've got a module called Loader.bas, that I use to do most of the donkey work (loading and unloading any other modules that are required) - and I'd like to be able to load it up from a file as soon as the spreadsheet is opened.
I've attached the following code to the Workbook_Open event (in the ThisWorkbook class).
Private Sub Workbook_Open()
Call RemoveLoader
Call LoadLoader
End Sub
Where RemoveLoader (also within the ThisWorkbook class) contains the following code:
Private Sub RemoveLoader()
Dim y As Integer
Dim OldModules, NumModules As Integer
Dim CompName As String
With ThisWorkbook.VBProject
NumModules = ThisWorkbook.VBProject.VBComponents.Count
y = 1
While y <= NumModules
If .VBComponents.Item(y).Type = 1 Then
CompName = .VBComponents.Item(y).Name
If VBA.Strings.InStr(CompName, "Loader") > 0 Then
OldModules = ThisWorkbook.VBProject.VBComponents.Count
.VBComponents.Remove .VBComponents(CompName)
NumModules = ThisWorkbook.VBProject.VBComponents.Count
If OldModules - NumModules = 1 Then
y = 1
Else
MsgBox ("Failed to remove " & CompName & " module from VBA project")
End If
End If
End If
y = y + 1
Wend
End With
End Sub
Which is probably a bit overcomplicated and slightly crude - but I'm trying everything I can find to get it to load the external module!
Often, when I open the spreadsheet, the RemoveLoader function finds that there's a "Loader1" module already included in the VBA project that it is unable to remove, and it also fails to load the new Loader module from the file.
Any ideas if what I'm trying to do is possible? Excel seems very fond of appending a 1 to these module names - either when loading or removing (I'm not sure which).
There is an excellent solution to the vba version control problem here: https://github.com/hilkoc/vbaDeveloper
The nice part about this is that it exports your code automatically, as soon as you save your workbook. Also, when you open a workbook, it imports the code.
You don't need to run any build scripts or maven commands and you don't need to make any changes to your workbooks. It works for all.
It has also solved the import problem where modules such as ModName are being imported as ModName1 into a duplicate module. The importing works as it should, even when doing it multiple times.
As a bonus, it comes with a simple code formatter, that allows you to format your vba code as you write it within the VBA Editor.
Look at the VBAMaven page. I have a homegrown solution that uses the same concepts. I have a common library with a bunch of source code, an ant build and an 'import' VB script. Ant controls the build, which takes a blank excel file and pushes the needed code into it. #Mike is absolutely correct - any duplicate module definitions will automatically have a number appended to the module name. Also, class modules (as in Sheet and ThisWorkbook) classes require special treatment. You can't create those modules, you have to read the input file and write the buffer into the appropriate module. This is the VB script I currently use to do this. The section containing # delimited text (i.e. #build file#) are placeholders - the ant build replaces these tags with meaningful content. It's not perfect, but works for me.
''
' Imports VB Basic module and class files from the src folder
' into the excel file stored in the bin folder.
'
Option Explicit
Dim pFileSystem, pFolder, pPath
Dim pShell
Dim pApp, book
Dim pFileName
pFileName = "#build file#"
Set pFileSystem = CreateObject("Scripting.FileSystemObject")
Set pShell = CreateObject("WScript.Shell")
pPath = pShell.CurrentDirectory
If IsExcelFile (pFileName) Then
Set pApp = WScript.CreateObject ("Excel.Application")
pApp.Visible = False
Set book = pApp.Workbooks.Open(pPath & "\build\" & pFileName)
Else
Set pApp = WScript.CreateObject ("Word.Application")
pApp.Visible = False
Set book = pApp.Documents.Open(pPath & "\build\" & pFileName)
End If
'Include root source folder code if no args set
If Wscript.Arguments.Count = 0 Then
Set pFolder = pFileSystem.GetFolder(pPath & "\src")
ImportFiles pFolder, book
'
' Get selected modules from the Common Library, if any
#common path##common file#
Else
'Add code from subdirectories of src . . .
If Wscript.Arguments(0) <> "" Then
Set pFolder = pFileSystem.GetFolder(pPath & "\src\" & Wscript.Arguments(0))
ImportFiles pFolder, book
End If
End If
Set pFolder = Nothing
Set pFileSystem = Nothing
Set pShell = Nothing
If IsExcelFile (pFileName) Then
pApp.ActiveWorkbook.Save
Else
pApp.ActiveDocument.Save
End If
pApp.Quit
Set book = Nothing
Set pApp = Nothing
'' Loops through all the .bas or .cls files in srcFolder
' and calls InsertVBComponent to insert it into the workbook wb.
'
Sub ImportFiles(ByVal srcFolder, ByVal obj)
Dim fileCollection, pFile
Set fileCollection = srcFolder.Files
For Each pFile in fileCollection
If Right(pFile, 3) = "bas _
Or Right(pFile, 3) = "cls _
Or Right(pFile, 3) = "frm Then
InsertVBComponent obj, pFile
End If
Next
Set fileCollection = Nothing
End Sub
'' Inserts the contents of CompFileName as a new component in
' a Workbook or Document object.
'
' If a class file begins with "Sheet", then the code is
' copied into the appropriate code module 1 painful line at a time.
'
' CompFileName must be a valid VBA component (class or module)
Sub InsertVBComponent(ByVal obj, ByVal CompFileName)
Dim t, mName
t = Split(CompFileName, "\")
mName = Split(t(UBound(t)), ".")
If IsSheetCodeModule(mName(0), CompFileName) = True Then
ImportCodeModule obj.VBProject.VBComponents(mName(0)).CodeModule, _
CompFileName
Else
If Not obj Is Nothing Then
obj.VBProject.VBComponents.Import CompFileName
Else
WScript.Echo "Failed to import " & CompFileName
End If
End If
End Sub
''
' Imports the code in the file fName into the workbook object
' referenced by mName.
' #param target destination CodeModule object in the excel file
' #param fName file system file containing code to be imported
Sub ImportCodeModule (ByVal target, ByVal fName)
Dim shtModule, code, buf
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Set buf = fso.OpenTextFile(fName, ForReading, False, TristateUseDefault)
buf.SkipLine
code = buf.ReadAll
target.InsertLines 1, code
Set fso = Nothing
End Sub
''
' Returns true if the code module in the file fName
' appears to be a code module for a worksheet.
Function IsSheetCodeModule (ByVal mName, ByVal fName)
IsSheetCodeModule = False
If mName = "ThisWorkbook" Then
IsSheetCodeModule = False
ElseIf Left(mName, 5) = "Sheet" And _
IsNumeric(Mid (mName, 6, 1)) And _
Right(fName, 3) = "cls Then
IsSheetCodeModule = True
End If
End Function
''
' Returns true if fName has a xls file extension
Function IsExcelFile (ByVal fName)
If Right(fName, 3) = "xls" Then
IsExcelFile = True
Else
IsExcelFile = False
End If
End Function
I've been working on exactly this for months. I think I figured it out.
If the VB Project is trying to remove a module containing something in the call stack, it delays the removal until the call stack pops the module being replaced.
To avoid a module being in the call stack, launch your code with Application.OnTime
Private Sub Workbook_Open()
'WAS: module_library (1)
Application.OnTime (Now + TimeValue("00:00:01")), "load_library_kicker_firstiter"
End Sub
If you are self-healing your code like I am, you'll also have to launch your code that overwrites the 'calling' code with that same strategy.
I did not perform extensive testing yet, I am in total celebration mode, but this gets me extremely close to straightforward 99.9% self-healing code within a standalone .xls file without any other tricks
Usually the "Loader1" thing happens when Excel is asked to import a module and a module already exists with the same name. So if you import "Loader", then load it again and you'll get "Loader1". This would be because Excel doesn't know (or maybe just doesn't care) if it's really the same thing or a new chunk of functionality that just happens have the same module name, so it imports it anyway.
I can't think of a perfect solution, but I think I'd be inclined to try putting the load/unload logic in an add-in - that Workbook_Open thing looks a little vulnerable and having it in all workbooks is going to be a huge pain if the code ever needs to change (never say never). The XLA logic might be more complex (trickier to trap the necessary events, for one thing) but at least it'll only exist in one place.
Can't leave comment to comment
There is an excellent solution to the vba version control problem
here: https://github.com/hilkoc/vbaDeveloper
About saving custom VBAProjects using this XLAM.
Try this in Build.bas:
'===============
Public Sub testImport()
Dim proj_name As String
Dim vbaProject As Object
'proj_name = "VBAProject"
'Set vbaProject = Application.VBE.VBProjects(proj_name)
Set vbaProject = Application.VBE.ActiveVBProject
proj_name = vbaProject.name
Build.importVbaCode vbaProject
End Sub
'===============
Public Sub testExport()
Dim proj_name As String
Dim vbaProject As Object
'proj_name = "VBAProject"
'Set vbaProject = Application.VBE.VBProjects(proj_name)
Set vbaProject = Application.VBE.ActiveVBProject
proj_name = vbaProject.name
Build.exportVbaCode vbaProject
End Sub
'===============
This will export/import Active VBA Project.
The following is an easy-to-implement answer if you don't need to export your VBA code automatically. Just Call the following sub and it will export (as text) the VBA code of the current active workbook in a subfolder named "VC_nameOfTheWorkBook". If your project is a .xlam, you need to temporarily set the IsAddin property to false. Then you can easily add the new subfolder to Git. It is a slight modification of the code found here made by Steve Jansen. For a more complete solution see Ron de Bruin post.
You need to set a reference to "Microsoft Visual Basic For Applications Extensibility 5.3" and to "Microsoft Scripting Runtime" in the VBE Editor.
Public Sub ExportVisualBasicCode()
Const Module = 1
Const ClassModule = 2
Const Form = 3
Const Document = 100
Const Padding = 24
Dim VBComponent As Object
Dim path As String
Dim directory As String
Dim extension As String
Dim fso As New FileSystemObject
directory = ActiveWorkbook.path & "\VC_" & fso.GetBaseName(ActiveWorkbook.Name)
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
Debug.Print "Exported " & Left$(VBComponent.Name & ":" & Space(Padding), Padding) & path
End If
On Error GoTo 0
Next
End Sub