How to get a value from nested / staggered Excel object - data from json - arrays
I have tried many JSON addins for Excel but I am having no luck parsing the JSON data below. finally I have managed to use the code below
Sub jsonDecode()
Dim jsonDecode As Variant
jsonText = Worksheets("Sheet3").Range("A1").Value
Set sc = CreateObject("ScriptControl"): sc.Language = "JScript"
Set jsonDecode = sc.Eval("(" + jsonText + ")")
End Sub
to create a staggered object but cannot access the values in the image below.
I have tried the following
msgbox(jsonDecode.location.id)
msgbox(tostring(jsonDecode.location.id))
msgbox(jsonDecode(location(id)))
Any help would be really appreciated for the code to get the values marked A and B in the image below :)
Forgive me if my terminology is a bit skewif
Cheers!!
Image of the array tree in Excel locals window
JSON text is
{"location":{"id":2456,"name":"Tuggerah","region":"Central Coast","state":"NSW","postcode":"2259","timeZone":"Australia/Sydney","lat":-33.30701,"lng":151.4159,"typeId":1},"forecasts":{"weather":{"days":[{"dateTime":"2016-09-13 00:00:00","entries":[{"dateTime":"2016-09-13 00:00:00","precisCode":"showers-rain","precis":"Late rain","precisOverlayCode":"","night":false,"min":10,"max":22}]}],"units":{"temperature":"c"},"issueDateTime":"2016-09-13 11:35:20"},"wind":{"days":[{"dateTime":"2016-09-13 00:00:00","entries":[{"dateTime":"2016-09-13 00:00:00","speed":9.1,"direction":287,"directionText":"WNW"},{"dateTime":"2016-09-13 01:00:00","speed":9.3,"direction":258,"directionText":"WSW"},{"dateTime":"2016-09-13 02:00:00","speed":9.3,"direction":256,"directionText":"WSW"},{"dateTime":"2016-09-13 03:00:00","speed":9.1,"direction":254,"directionText":"WSW"},{"dateTime":"2016-09-13 04:00:00","speed":6.9,"direction":260,"directionText":"W"},{"dateTime":"2016-09-13 05:00:00","speed":5.7,"direction":256,"directionText":"WSW"},{"dateTime":"2016-09-13 06:00:00","speed":5.7,"direction":249,"directionText":"WSW"},{"dateTime":"2016-09-13 07:00:00","speed":5.9,"direction":245,"directionText":"WSW"},{"dateTime":"2016-09-13 08:00:00","speed":5.2,"direction":254,"directionText":"WSW"},{"dateTime":"2016-09-13 09:00:00","speed":4.6,"direction":272,"directionText":"W"},{"dateTime":"2016-09-13 10:00:00","speed":4.6,"direction":281,"directionText":"W"},{"dateTime":"2016-09-13 11:00:00","speed":6.1,"direction":312,"directionText":"NW"},{"dateTime":"2016-09-13 12:00:00","speed":8,"direction":14,"directionText":"NNE"},{"dateTime":"2016-09-13 13:00:00","speed":9.6,"direction":45,"directionText":"NE"},{"dateTime":"2016-09-13 14:00:00","speed":9.8,"direction":56,"directionText":"NE"},{"dateTime":"2016-09-13 15:00:00","speed":9.6,"direction":77,"directionText":"ENE"},{"dateTime":"2016-09-13 16:00:00","speed":9.4,"direction":88,"directionText":"E"},{"dateTime":"2016-09-13 17:00:00","speed":10.7,"direction":73,"directionText":"ENE"},{"dateTime":"2016-09-13 18:00:00","speed":11.9,"direction":43,"directionText":"NE"},{"dateTime":"2016-09-13 19:00:00","speed":12.6,"direction":28,"directionText":"NNE"},{"dateTime":"2016-09-13 20:00:00","speed":11.7,"direction":11,"directionText":"N"},{"dateTime":"2016-09-13 21:00:00","speed":9.8,"direction":336,"directionText":"NNW"},{"dateTime":"2016-09-13 22:00:00","speed":7.8,"direction":318,"directionText":"NW"},{"dateTime":"2016-09-13 23:00:00","speed":4.6,"direction":304,"directionText":"NW"}]}],"units":{"speed":"km/h"},"issueDateTime":"2016-09-13 12:11:55"}},"forecastGraphs":{"temperature":{"dataConfig":{"series":{"config":{"id":"temperature","color":"#003355","lineWidth":2,"lineFill":false,"lineRenderer":"StraightLineRenderer","showPoints":false,"pointFormatter":"TemperaturePointFormatter"},"yAxisDataMin":10.7,"yAxisDataMax":22.2,"yAxisMin":0,"yAxisMax":32,"groups":[{"dateTime":1473724800,"points":[{"x":1473724800,"y":12.4},{"x":1473728400,"y":11.7},{"x":1473732000,"y":11.3},{"x":1473735600,"y":11},{"x":1473739200,"y":10.9},{"x":1473742800,"y":10.7},{"x":1473746400,"y":11},{"x":1473750000,"y":12.2},{"x":1473753600,"y":14.2},{"x":1473757200,"y":16.8},{"x":1473760800,"y":19.3},{"x":1473764400,"y":21},{"x":1473768000,"y":21.9},{"x":1473771600,"y":22.2},{"x":1473775200,"y":22.2},{"x":1473778800,"y":21.7},{"x":1473782400,"y":20.7},{"x":1473786000,"y":19.1},{"x":1473789600,"y":17.6},{"x":1473793200,"y":16.1},{"x":1473796800,"y":15.3},{"x":1473800400,"y":14.9},{"x":1473804000,"y":14.6},{"x":1473807600,"y":14.1}]}],"controlPoints":{"pre":{"x":1473721200,"y":10.2},"post":{"x":1473811200,"y":13.7}}},"xAxisMin":1473724800,"xAxisMax":1473811199},"units":{"temperature":"c"},"issueDateTime":"2016-09-13 07:21:53","nextIssueDateTime":"2016-09-13 08:21:53"},"precis":{"dataConfig":{"series":{"config":{"id":"precis","lineFill":false,"showPoints":true,"pointRenderer":"PrecisSummaryPointRenderer","pointFormatter":"PrecisSummaryPointFormatter"},"groups":[{"dateTime":1473724800,"points":[{"x":1473728400,"precisCode":"partly-cloudy","night":true},{"x":1473739200,"precisCode":"fog","night":true},{"x":1473750000,"precisCode":"mostly-cloudy","night":false},{"x":1473760800,"precisCode":"mostly-cloudy","night":false},{"x":1473771600,"precisCode":"mostly-cloudy","night":false},{"x":1473782400,"precisCode":"mostly-cloudy","night":false},{"x":1473793200,"precisCode":"chance-shower-cloud","night":true},{"x":1473804000,"precisCode":"showers-rain","night":true}]}],"controlPoints":[]},"xAxisMin":1473724800,"xAxisMax":1473811199}}},"observational":{"observations":{"temperature":{"temperature":18.5,"apparentTemperature":17.4,"trend":-1},"humidity":{"percentage":87},"dewPoint":{"temperature":16.3,"trend":1},"pressure":{"pressure":1019.3,"trend":null},"wind":{"speed":16.7,"gustSpeed":20.4,"trend":0,"direction":202.5,"directionText":"SSW"},"rainfall":{"lastHourAmount":0,"todayAmount":0,"since9AMAmount":0}},"stations":{"temperature":{"name":"Norah Head AWS","distance":15.5},"pressure":{"name":"Norah Head AWS","distance":15.5},"wind":{"name":"Norah Head AWS","distance":15.5},"rainfall":{"name":"Norah Head AWS","distance":15.5}},"issueDateTime":"2016-09-13 12:20:00","units":{"temperature":"c","amount":"mm","speed":"km/h","distance":"km","pressure":"hPa"}},"observationalGraphs":{"pressure":{"dataConfig":{"series":{"config":{"id":"pressure","color":"#003355","lineWidth":2,"lineFill":false,"lineRenderer":"StraightLineRenderer","showPoints":false,"pointFormatter":"PressurePointFormatter"},"yAxisDataMin":1018.2,"yAxisDataMax":1020.9,"yAxisMin":850,"yAxisMax":1100,"groups":[{"dateTime":1473724800,"points":[{"x":1473724800,"y":1019.4},{"x":1473728400,"y":1019.9},{"x":1473730200,"y":1019.4},{"x":1473732000,"y":1019.1},{"x":1473733800,"y":1018.7},{"x":1473735600,"y":1018.2},{"x":1473737400,"y":1018.5},{"x":1473739200,"y":1018.8},{"x":1473741000,"y":1019.1},{"x":1473742800,"y":1019.1},{"x":1473744600,"y":1019.3},{"x":1473746400,"y":1019.7},{"x":1473748200,"y":1020},{"x":1473750000,"y":1020.1},{"x":1473751800,"y":1020.5},{"x":1473753600,"y":1020.9},{"x":1473755400,"y":1020.9},{"x":1473757200,"y":1020.9},{"x":1473759000,"y":1020.4},{"x":1473760800,"y":1020.4},{"x":1473762600,"y":1020.5},{"x":1473764400,"y":1020.5},{"x":1473766200,"y":1019.8},{"x":1473768000,"y":1019.3}]}],"controlPoints":[]},"xAxisMin":1473724800,"xAxisMax":1473897599},"units":{"pressure":"hpa"},"provider":{"id":329,"name":"Norah Head AWS","lat":-33.28,"lng":151.58,"distance":15.5,"units":{"distance":"km"}}},"temperature":{"dataConfig":{"series":{"config":{"id":"temperature","color":"#003355","lineWidth":2,"lineFill":false,"lineRenderer":"StraightLineRenderer","showPoints":false,"pointFormatter":"TemperaturePointFormatter"},"yAxisDataMin":15.1,"yAxisDataMax":20.1,"yAxisMin":0,"yAxisMax":32,"groups":[{"dateTime":1473724800,"points":[{"x":1473724800,"y":15.6},{"x":1473725400,"y":16.1},{"x":1473726000,"y":16.1},{"x":1473726600,"y":16.1},{"x":1473727200,"y":15.8},{"x":1473727800,"y":15.9},{"x":1473728400,"y":16},{"x":1473729000,"y":15.9},{"x":1473729600,"y":15.9},{"x":1473730200,"y":15.8},{"x":1473730800,"y":15.6},{"x":1473731400,"y":15.4},{"x":1473732000,"y":15.4},{"x":1473732600,"y":15.4},{"x":1473733200,"y":15.5},{"x":1473733800,"y":15.3},{"x":1473734400,"y":15.3},{"x":1473735000,"y":15.1},{"x":1473735600,"y":15.3},{"x":1473736200,"y":15.3},{"x":1473736800,"y":15.5},{"x":1473737400,"y":15.5},{"x":1473738000,"y":15.5},{"x":1473738600,"y":15.4},{"x":1473739200,"y":15.5},{"x":1473739800,"y":15.6},{"x":1473740400,"y":15.7},{"x":1473741000,"y":15.8},{"x":1473741600,"y":15.9},{"x":1473742200,"y":16.1},{"x":1473742800,"y":16.2},{"x":1473743400,"y":16.4},{"x":1473744000,"y":16.4},{"x":1473744600,"y":16.4},{"x":1473745200,"y":16.4},{"x":1473745800,"y":16.3},{"x":1473746400,"y":16.3},{"x":1473747000,"y":16.4},{"x":1473747600,"y":16.4},{"x":1473748200,"y":16.5},{"x":1473748800,"y":16.6},{"x":1473749400,"y":16.8},{"x":1473750000,"y":16.8},{"x":1473750600,"y":16.9},{"x":1473751200,"y":17},{"x":1473751800,"y":17.1},{"x":1473752400,"y":17.4},{"x":1473753000,"y":17.4},{"x":1473753600,"y":17.6},{"x":1473754200,"y":17.9},{"x":1473754800,"y":17.9},{"x":1473755400,"y":17.9},{"x":1473756000,"y":17.9},{"x":1473756600,"y":18.2},{"x":1473757200,"y":18.2},{"x":1473757800,"y":18.3},{"x":1473758400,"y":18.2},{"x":1473759000,"y":18.3},{"x":1473759600,"y":18.4},{"x":1473760200,"y":18.6},{"x":1473760800,"y":18.8},{"x":1473761400,"y":18.7},{"x":1473762000,"y":18.6},{"x":1473762600,"y":18.4},{"x":1473763200,"y":18.6},{"x":1473763800,"y":19.2},{"x":1473764400,"y":20.1},{"x":1473765000,"y":19.6},{"x":1473765600,"y":20.1},{"x":1473766200,"y":20},{"x":1473766800,"y":20.1},{"x":1473767400,"y":19.2},{"x":1473768000,"y":18.8},{"x":1473768600,"y":18.6},{"x":1473769200,"y":18.5}]}],"controlPoints":[]},"xAxisMin":1473724800,"xAxisMax":1473897599},"units":{"temperature":"c"},"provider":{"id":329,"name":"Norah Head AWS","lat":-33.28,"lng":151.58,"distance":15.5,"units":{"distance":"km"}}}},"regionPrecis":{"days":[{"dateTime":"2016-09-13 00:00:00","entries":[{"dateTime":"2016-09-13 00:00:00","precis":"Cloudy. Patchy fog early this morning. High (70%) chance of rain in the late evening. Light winds becoming northeasterly 15 to 20 km/h in the late afternoon then tending northerly in the evening."}]}],"issueDateTime":"2016-09-13 10:41:16","name":"Central Coast"}}
Your approach uses JScript within VBA over ScriptControl object. This approach is not recommendable since ScriptControl object is only a 32-bit ActiveX component. It will not work with 64-bit versions of Office.
You can make it work if you accept that JScript objects are different from VBA objects. So you need a JScript method to get the JScript objects.
Example:
Sub jsonDecode()
Dim jsonDecode As Variant
jsonText = Worksheets("Sheet3").Range("A1").Value
Set sc = CreateObject("ScriptControl"): sc.Language = "JScript"
sc.AddCode "function getProperty(jsonObj, propertyName) { return jsonObj[propertyName]; } "
Set jsonDecode = sc.Eval("(" + jsonText + ")")
Set oLocation = sc.Run("getProperty", jsonDecode, "location")
MsgBox sc.Run("getProperty", oLocation, "id")
Set oForecasts = sc.Run("getProperty", jsonDecode, "forecasts")
Set oWeather = sc.Run("getProperty", oForecasts, "weather")
Set oDays = sc.Run("getProperty", oWeather, "days")
Set oDay0 = sc.Run("getProperty", oDays, "0")
MsgBox sc.Run("getProperty", oDay0, "dateTime")
End Sub
Here function getProperty is the JScript method to get the JScript objects.
But as stated already you should look for better methods parsing JSON with VBA. There are some if you search.
You may use the free Microsoft Excel add-In Power Query* (from Excel 2010) to browse and extract data from your JSON file.
On superuser you have an example.
*Power Query is known as Get & Transform in Excel 2016 and is full part of the software
The excel-requests Addin might be of help (disclaimer: I'm the author of this open source project).
You can find docs, installer script etc here: http://excel-requests.readthedocs.io/en/latest/.
Let me know if you need help.
Related
Libreoffice Base - how to call a control event from a macro?
Question: I need to manually call an object listener event (e.g. key pressed) to trigger a function. I used to do it in Access but haven't found the documentation for it in LibreOffice Base. Context: Having retired from software development 7 years ago, I am doing a favour for a friend by building a database in LibreOffice Base. Previously experienced in Access - but more with Oracle, PL/SQL, APEX, etc! I am struggling a little in getting it to do what I know can be done!
Here is the code I've tried so far.
Sub CauseKeyPressedEventToBeFired
oDoc = ThisComponent
oController = oDoc.getCurrentController()
oVC = oController.getViewCursor()
oForm = oDoc.getDrawpage().getForms().getByName("Form")
oTextBox = oForm.getByName("Text Box 1")
oControlView = oController.getControl(oTextBox)
oControlView.setFocus()
Dim oEvent As New com.sun.star.awt.KeyEvent
oEvent.Source = oControlView
oEvent.KeyCode = com.sun.star.awt.Key.A
oControlView.keyPressed(oEvent)
End Sub
However, it doesn't seem to work on my system (LibreOffice 6.4.3.2 on Windows). I also found this post, but that code doesn't seem to work for me either.
I searched for com.sun.star.awt.XToolkitRobot, but it's not in the API documentation, perhaps because the functionality is not fully supported. Presumably, it can be obtained from com.sun.star.awt.Toolkit.
For more help, post a question on ask.libreoffice.org. I'd suggest explaining why you want to do this, because there may be a different kind of solution. Ratslinger has a lot of experience solving various database problems, and he'll probably direct you toward a simpler solution that doesn't involve this kind of event hacking.
a function (i.e. a procedure that returns a value)
Yes, that is what a function is. But "an object listener event" implies, correctly I think, that we're talking about the method of an object instead. That's what LibreOffice event listeners are in Python or Java, although in Basic, they're a little strange, using the object name as some kind of magic to determine what they apply to. Anyway, that's getting off track, because your question isn't about listening for events, but rather about triggering them.
EDIT:
The following Python code works. The problem with my earlier attempts was that oEvent.KeyChar needs to be set, and that doesn't seem to work in Basic. I can't imagine why, unless I am ignoring some obvious mistake in the Basic code.
def causeKeyPressedEventToBeFired(oEvent=None):
oDoc = XSCRIPTCONTEXT.getDocument()
oController = oDoc.getCurrentController()
oForm = oDoc.getDrawPage().getForms().getByName("Form")
oTextBox = oForm.getByName("Text Box 1")
oControlView = oController.getControl(oTextBox)
oControlView.setFocus()
oEvent = uno.createUnoStruct("com.sun.star.awt.KeyEvent")
oEvent.Source = oControlView
from com.sun.star.awt.Key import A
oEvent.KeyCode = A
oEvent.KeyChar = "a" # works in Python but strangely not in Basic
simulate_KeyPress(oEvent)
def simulate_KeyPress(oKeyEvent):
oDoc = XSCRIPTCONTEXT.getDocument()
oWindow = oDoc.CurrentController.Frame.getContainerWindow()
oKeyEvent.Source = oWindow
oToolkit = oWindow.getToolkit()
oToolkit.keyPress(oKeyEvent)
oToolkit.keyRelease(oKeyEvent)
EDIT 2:
Finally, here is working Basic code. In the earlier attempt, the type was wrong.
Sub CauseKeyPressedEventToBeFired
oDoc = ThisComponent
oController = oDoc.getCurrentController()
oForm = oDoc.getDrawpage().getForms().getByName("Form")
oTextBox = oForm.getByName("Text Box 1")
oControlView = oController.getControl(oTextBox)
oControlView.setFocus()
Dim oEvent As New com.sun.star.awt.KeyEvent
oEvent.KeyCode = com.sun.star.awt.Key.A
oEvent.KeyChar = CByte(97)
simulate_KeyPress(oEvent)
End Sub
Sub simulate_KeyPress(oKeyEvent As com.sun.star.awt.KeyEvent)
oWindow = ThisComponent.CurrentController.Frame.getContainerWindow()
oKeyEvent.Source = oWindow
oToolkit = oWindow.getToolkit()
oToolkit.keyPress(oKeyEvent)
oToolkit.keyRelease(oKeyEvent)
End Sub
Create reference table or array inside of the code
I am trying to create a function that allows me to put in a location number and the result will give me a unique location code. The problem is I want all of the referencing done inside of the macro code, not to get the information from somewhere in the spreadsheet. (this code is going into an add-in so there is no worksheet to reference from). I basically want to do a vlookup but inside of the code, not in a worksheet.
I haven't been able to find out how to do this, the code below is something like what I am looking for, I am thinking maybe the use of an array but I can't figure out how to use it the way I want.
I know this doesn't work but I am trying to do something like this below so that when I type in =GetCode(415) the result is 001
Function GetCode(LocationNum As String) As String
Dim Result As String
'Built in reference table
'
'{ "415" : "001"
' "500" : "002"
' "605" : "003"
' }
Dim varData(2) As Variant
varData("415") = "001"
varData("500") = "002"
varData("605") = "003"
Result = varData(LocationNum)
GetCode = Result
End Function
As Nathan_Sav has already mentioned, you can use a collection or dictionary instead, which are much more efficient. Here's an example using the dictionary object. Note that it uses early binding, so you'll need to set a reference to the Microsoft Scripting Runtime library (Visual Basic Editor >> Tools >> Reference).
Option Explicit
Sub test()
'set a reference (VBE >> Tools >> Reference) to the Microsoft Scripting Runtime library
'declare and create an instance of the dictionary object
Dim dic As Scripting.Dictionary
Set dic = New Scripting.Dictionary
'set the comparison mode for the dictionary to a case-insensitive match
dic.CompareMode = TextCompare
'add keys and associated items to the dictionary
dic.Add Key:="415", Item:="001"
dic.Add Key:="500", Item:="002"
dic.Add Key:="605", Item:="003"
'print to the immediate window the item associated with the specified key
Debug.Print dic("415")
'clear from memory
Set dic = Nothing
End Sub
Trouble with CreateNewSite() bindings -- WMI -- IIS6
I am successfully creating new IIS 6 websites using the CreateNewSite() function, but would like to add an additional two hostname bindings (see below).
Questions:
Does the CreateNewSite() function support multiple hostname bindings?
If so, what is the syntax? In all the example code I've found out there, I only find copies of the original MS code, with no examples of additional bindings, or even examples of modification functions.
I have already reviewed this blog page...
http://stweet.wordpress.com/2010/03/15/creating-a-new-website-programmatically-on-iis-using-asp-net/
... and while I saw something that looked like multiple domains, the code format was different, and so I'm not sure how it relates to the VBS I am using.
Thanks,
Mik
`
Bindings = Array(0)
Set Bindings(0) = providerObj.get("ServerBinding").SpawnInstance_()
Bindings(0).IP = myIPnumber
Bindings(0).Port = "80"
Bindings(0).Hostname = WScript.Arguments(0)
' Create the new Web site using the CreateNewSite method of the IIsWebService object.
Dim strSiteObjPath
strSiteObjPath = serviceObj.CreateNewSite("RF_" & WScript.Arguments(0), Bindings, "D:\websites\" & WScript.Arguments(0) & "\httpdocs", WScript.Arguments(2))
`
The WScript.Arguments(2) is a custom IIS service number.
How to translate vb code into php code
I am unable to translate this below written VB script code into php code so please help me in providing with the php code by translating the given VB code. VBScript Sample: Dim HttpObj Dim sURL Dim sPage Dim strResult sURL = "http://example.com" Set HTTPObj = New MSXML2.XMLHTTP HTTPObj.open "get", sURL, False HTTPObj.Send sPage = HTTPObj.responseText
Based on the broken code you have pasted it would seem you want to fetch a xml page and convert into a usable array. The book contains just that, as an example twitter api Line 46 does your HttpObj Line 61 gets the data and converts to array. You can use the Xml libs instead. I have posted some 1.3 links, but it should be the same for 2.x. I just could not find the twitter example in the 2.x examples.
Version control Access 2007 database and application
I need to version control a Microsoft Access 2007 database and application. Currently everything is contained in a single mdb file. The application includes: Forms VBA code Actual database I would assume I need to separate the database from the forms/code. I would like to be able to version control the forms/code as text to support version diffs. At the moment I don't have access to SourceSafe (I heard there may be some access support) so I would prefer a solution that would work with subversion or git.
Access 2007 has a feature where you can split a DB into its Tables/Queries (backend) and Forms/Reports (front-end). Since your question mentions only version controlling the forms and modules, this might be a more elegant solution. I don't know where modules go after the split, so that might be a stumbling block. Microsoft offers VSTO (Visual Studio Tools for Office), which will let you develop in VS and run version control via any VS plugin (CVS/SVN/VSS/etc.). Finally, you can just directly connect to Visual Source Safe. This MSKB article has some good information and background to go through, while this Office Online article is designed for getting you up and running. Ultimately, I would suggest against taking the code out of Access if at all possible. Assuming the VBA editor is your primary development environment, you'll be adding extra steps to your development process that cannot easily be automated. Every change you make will need to be manually exported, diff'd, and stored, and there is no Application.OnCompile event that you could use to export the changes. Even tougher, you'll have to manually import all changed source files from other developers when they do checkins.
I use the code below to extract the vba code from Excel files, you may be able to modify this to extract from Access.
Sub ExtractVBACode(strSource, objFSO, strExportPath, objLogFile)
Dim objExcel
Dim objWorkbook
Dim objVBComponent
Dim strFileSuffix
Dim strExportFolder
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = true
Set objWorkbook = objExcel.Workbooks.Open(Trim(strSource))
strExportFolder = strExportPath & objFSO.GetBaseName(objWorkbook.Name)
If Not objFSO.FolderExists(strExportFolder) Then
objFSO.CreateFolder(strExportFolder)
End If
For Each objVBComponent In objWorkbook.VBProject.VBComponents
Select Case objVBComponent.Type
Case vbext_ct_ClassModule, vbext_ct_Document
strFileSuffix = ".cls"
Case vbext_ct_MSForm
strFileSuffix = ".frm"
Case vbext_ct_StdModule
strFileSuffix = ".bas"
Case Else
strFileSuffix = ""
End Select
If strFileSuffix <> "" Then
On Error Resume Next
Err.Clear
objVBComponent.Export strExportFolder & "\" & objVBComponent.Name & strFileSuffix
If Err.Number <> 0 Then
objLogFile.WriteLine ("Failed to export " & strExportFolder & "\" & objVBComponent.Name & strFileSuffix)
Else
objLogFile.WriteLine ("Export Successful: " & strExportFolder & "\" & objVBComponent.Name & strFileSuffix)
End If
On Error Goto 0
End If
Next
objExcel.DisplayAlerts = False
objExcel.Quit
End Sub
Can you extract the forms as XML perhaps?
I've struggled with this same problem. I originally wrote code very much like the existing answer. The trick is to get all of your modules onto the file system, but that method has some drawbacks. Going that route, you can get your forms and reports out of the VBA Projects, but you can't get them back in. So, I created a library as part of our Rubberduck VBE Add-in. The library I wrote takes care of importing and exporting all of your code to/from the VBA project to/from the repository as you seemlessly push, pull, and commit. It's a free and open source project, so feel free to download and install the latest version.
Here is an example of how the library is used. I'll be adding actual integration with the VBA editor in a future release.
Dim factory As New Rubberduck.SourceControlClassFactory
Dim repo As Rubberduck.IRepository
Dim git As ISourceControlProvider
Dim xl As New Excel.Application
xl.Visible = true
Dim wb As Excel.Workbook
Set wb = xl.Workbooks.Open("C:\Path\to\workbook.xlsm")
' create class instances to work with
Set repo = factory.CreateRepository(wb.VBProject.Name, "C:\Path\to\local\repository\SourceControlTest", "https://github.com/ckuhn203/SourceControlTest.git")
Set git = factory.CreateGitProvider(wb.VBProject, repo, "userName", "passWord")
' Create new branch to modify.
git.CreateBranch "NewBranchName"
' It is automatically checked out.
Debug.Print "Current Branch: " & git.CurrentBranch
' add a new standard (.bas) code module and a comment to that file
wb.VBProject.VBComponents.Add(vbext_ct_StdModule).CodeModule.AddFromString "' Hello There"
' add any new files to tracking
Dim fileStat As Rubberduck.FileStatusEntry
For Each fileStat In git.Status
' fileStat.FileStatus is a bitwise enumeration, so we use bitwise AND to test for equality here
If fileStat.FileStatus And Rubberduck.FileStatus.Added Then
git.AddFile fileStat.FilePath
End If
Next
git.Commit "commit all modified files"
' Revert the last commit, throwing away the changes we just made.
git.Revert