i do have several hundred of excel files. Every excel file contains a makro in the "workbooks_open" method. I want to open all these files, comment out the code, save and close the file.
a loop through all files with open/close is not a problem, but with the changing of the vba code i have no idea.
many thanks in advance!
Sub test()
Dim Path as string = "C:\123\"
Dim cDir As String
cDir = Dir(Path & "*.xlsx")
Do While cDir <> ""
Application.DisplayAlerts = False
'### open
Workbooks.Open Filename:=Path & cDir
'### here i want to deactivate/comment out the makro in the workbook_open method
'### save
ActiveWorkbook.Save
ActiveWorkbook.Saved = True
'### close
ActiveWorkbook.Close False
cDir = Dir
Loop
End Sub
To access the code of a workbook using code, you need to allow access to the VBE via code - see https://stackoverflow.com/a/11680865/7599798 how to do so.
You access all the coding stuff of a workbook using its VBProject-Property.
If you want to use the Types and Constants of the Project, add a reference to Microsoft Visual Basic for Applications Extensibility
The VBProject contains a collection of Components VBComponents, this is the list you see in the VBE in the project window, it contains all modules, classes and forms.
The Workbook-Module has the Name ThisWorkbook and it's type = 100 (use vbext_ct_Document if you have added the mentioned reference)
To access the code of a module, use the property CodeModule of the component.
The lines of code can be fetched using the lines-property of CodeModule, you need to pass two parameters (startrow and numbers of rows).
The lines-property is read only, if you want to change code, you can use the methods InsertLines, DeleteLines and ReplaceLines
Have a look to the next routine to see how it could look like. It will simply replace the Workbook_Open()-routine with Workbook_Open_BACKUP() so it will no longer fire when the workbook is opened.
Sub RemoveOnOpen(wb As Workbook)
Dim i As Long
With wb.VBProject
For i = 1 to .VBComponents.Count
' Debug.Print .VBComponents(i).Type, .VBComponents(i).Name
If .VBComponents(i).Type = vbext_ct_Document And .VBComponents(i).Name = "ThisWorkbook" Then
Dim row As Long
For row = 1 To .VBComponents(i).CodeModule.CountOfLines
Dim module As CodeModule, line As String
Set module = .VBComponents(i).CodeModule
line = Trim(module.Lines(row, 1))
If Left(line, 27) = "Private Sub Workbook_Open()" Then
module.ReplaceLine row, Replace(line, "Workbook_Open()", "Workbook_Open_BACKUP()")
End If
Next
End If
Next i
End With
End Sub
Update: As T.M. noted, the name of the Workbook module may be different if used in a different language environment, you should check this.
I also added a Trim-statement when checking the code line for the Sub.
Please, use the next Sub. It should be called by the code iterating between all workbooks to be changed:
Sub ComSpecSub(wb As Workbook, moduleName As String, strLine As String)
Dim objThisWb As VBComponent, CodeM As CodeModule, i As Long, j As Long
Set objThisWb = wb.VBProject.VBComponents("ThisWorkbook")
Set CodeM = objThisWb.CodeModule
If CodeM.Find(strLine, 1, 1, CodeM.CountOfLines, 1, False) = True Then
For i = 1 To CodeM.CountOfLines
If InStr(CodeM.lines(i, 1), strLine) > 0 Then
If left(CodeM.lines(i, 1), 1) = "'" Then Exit Sub 'already commented...
'if running the code again
Do While i + j <= CodeM.CountOfLines
CodeM.ReplaceLine i + j, "'" & CodeM.lines(i + j, 1)
If InStr(CodeM.lines(i + j, 1), "End Sub") > 0 Then Exit Do
j = j + 1
Loop
End If
Next i
End If
End Sub
The above code needs a reference to 'Microsoft Visual Basic for Applications Extensibility'
It should be called from your code as:
ComSpecSub ActiveWorkbook, "ThisWorkbook", "Private Sub Workbook_Open()"
ActiveWorkbook.Close True
If adding the required reference looks problematic, please firstly run the next code, which will add it automatically:
Sub addExtenssibilityReference()
'Add a reference to 'Microsoft Visual Basic for Applications Extensibilty 5.3':
ThisWorkbook.VBProject.References.AddFromGuid _
GUID:="{0002E157-0000-0000-C000-000000000046}", _
Major:=5, Minor:=3
End Sub
Language independant & no loops
In addition to the valid answers of #FunThomas (following his renaming idea) and #FaneDuru I demonstrate an approach with two benefits:
the component ThisWorkbook can be found independantly from regional language settings via wb.VBProject.VBComponents(wb.CodeName),
as workbooks can be referenced not only by their name string which may differ for other languages than English,
but also via a workbook's wb.CodeName property (similar for sheets);
the effective procedure start row can be found in one go via
.ProcBodyLine(srchProcName, 0), where the zero input defines a sub or function procedure kind (other than Get|Let|Set props);
Further hints:
Needs a library reference to Microsoft Visual Basic for Applications Extensibility 5.3 (c.f. also #FaneDuru's progamatical approach).
Generally replacing a code line by another should consider possible line breaks ( _) resulting in two or several lines, too; due to the brevity of the procedure I don't assume a line break before "Workbook_Open" (like e.g. `Private Sub _".
Sub BackUp(wb as WorkBook, Optional ByVal srchProcName As String = "Workbook_Open")
'Purp: change a given procedures name in ThisWorkbook (e.g. "Workbook_Open") by adding "_BACKUP"
'0) Define backup name string
Dim backupName As String: backupName = srchProcName & "_BACKUP"
'1) Access ThisWorkbook directly by its CodeName (independant from regional language settings)!
Dim myComp As VBIDE.VBComponent
Set myComp = wb.VBProject.VBComponents(wb.CodeName)
'Debug.Print "** Code(Name): " & wb.CodeName & " (Local Name: " & myComp.Name & ")"
'2) Search directly for the effective start row of srchProcName (e.g. "Workbook_Open")
Dim effectiveRow As Long
With myComp.CodeModule ' the component's code module
On Error Resume Next
effectiveRow = .ProcBodyLine(srchProcName, 0) ' find effective row of search procedure
Select Case Err.Number
Case 0
Dim newContent As String
newContent = Replace(Trim(.Lines(effectiveRow, 1)), srchProcName, backupName)
.ReplaceLine effectiveRow, newContent
Debug.Print "** " & wb.Name & vbNewLine & "" _
; " Changed procedure '" & srchProcName & "' in row " & effectiveRow & _
" to " & backupName
Case 35
Debug.Print "** " & wb.Name & vbNewLine & _
" Error " & Err.Number & " " & Err.Description & vbNewLine & _
" Procedure '" & srchProcName & "' doesn't exist!" & vbNewLine & _
" (Possibly already 'backupped')": Err.Clear
Case Else
Debug.Print "** " & wb.Name & vbNewLine & _
" Error " & Err.Number & " " & Err.Description: Err.Clear
End Select
End With
End Sub
Example output in VB Editor's immeditate window
Inserting Backup ActiveWorkbook or a pre-set Backup wb in your code should suffice to rename existing "Workbook_Open" procedures by a "_BACKUP" suffix.
** ExampleWorkbook147.xlsm
Changed procedure 'Workbook_Open' in row 8 to Workbook_Open_BACKUP
In reply of #T.M comment and nice answer:
The next solution uses Find, which besides returning True when the searched string has been found, it modifies the StartLine parameter, if used as a variable. Then, since the question also involves commenting all the procedure lines, not only changing the declaration line, it will do it, without iteration, too:
Sub findProcThisWb(Optional wb As Workbook, Optional strLine As String = "Workbook_Open")
Dim thisWBCodeM As CodeModule, foundLine As Long, ProcExists As Boolean, arrPr
Dim procName As String, strCodeLine As String, strProcedure As String, strComProc As String
If wb Is Nothing Then Set wb = ThisWorkbook
Set thisWBCodeM = wb.VBProject.VBComponents(wb.CodeName).CodeModule
foundLine = 1 'initialize the line where from Find starts searching
Dim noLines As Long 'it will keep the found procedure number of lines
With thisWBCodeM
' ProcExists = .Find(strLine, foundLine, .CountOfLines, 1, -1, False, False) ' OP
ProcExists = .Find(strLine, foundLine, 1, .CountOfLines, -1, False, False) ' << Edit/2022-01-24 corr. argument order
Debug.Print foundLine: ' the line of the found procedure, if it has been found!
If ProcExists Then
strCodeLine = .lines(foundLine, 1) 'return the whole line
Debug.Print strCodeLine 'the whole line where the searched string has been found
procName = .ProcOfLine(foundLine, vbext_pk_Proc): Debug.Print "Proc name = " & procName
noLines = .ProcCountLines(procName, vbext_pk_Proc): Debug.Print "Number of procedure lines = " & noLines
strProcedure = .lines(foundLine, noLines): Debug.Print "The whole procedure:" & vbLf & strProcedure
arrPr = Split(strProcedure, vbLf)
strComProc = "'" & Join(arrPr, vbLf & "'"): Debug.Print "The whole commented procedure:" & vbLf; strComProc
'Delete the actual procedure lines:
.DeleteLines foundLine, noLines - 1 ' Edit 2022-01-24: -1
'Add the commented procedure code (from string, but not in the same place, after the declaration lines):
.AddFromString strComProc
End If
End With
End Sub
I am new to VBA and to use VBA on excel and write a macro to export an xml file per row (see the example in the print screen).
Unfortunately, I obtain following error
Run-time error '2147024891 (80070005)':
System error: -2147024891.
And when I click on the button "Debug" it jumps to the code line
doc.Save sFile
I use the following code for reading the excel sheet (Microsoft Excel for Mac Version 16.49) and creating a xml file:
Sub CustomerOutToXML()
sTemplateXML = _
"<?xml version='1.0'?>" + vbNewLine + _
"<ENVELOPE>" + vbNewLine + _
"<TRANSACTION>" + vbNewLine + _
"<TYPE>" + vbNewLine + "</TYPE>" + vbNewLine + _
"</TRANSACTION>" + vbNewLine + _
"<CONTENT>" + vbNewLine + vbNewLine + _
"<DATE>" + vbNewLine + "</DATE>" + vbNewLine + _
"<SSCC>" + vbNewLine + "</SSCC>" + vbNewLine + _
"<ORDER>" + vbNewLine + "</ORDER>" + vbNewLine + _
"</CONTENT>" + vbNewLine + _
"</ENVELOPE>"
Set doc = CreateObject("MSXML2.DOMDocument")
doc.async = False
doc.validateOnParse = False
doc.resolveExternals = False
With ActiveWorkbook.Worksheets(1)
lLastRow = .UsedRange.Rows.Count
For lRow = 2 To 7
sFile = "/Users/xxx/Documents/" & .Cells(lRow, 1).Value & ".xml"
Dim sDATE As String
Dim sSSCC As String 'Not Long
Dim sORDER As String
sDATE = CStr(.Cells(lRow, 2).Value)
sSSCC = .Cells(lRow, 3).Text ' <<< Not .Value
sORDER = CStr(.Cells(lRow, 4).Value)
sTransactionType = ActiveSheet.Name
doc.LoadXML sTemplateXML
doc.getElementsByTagName("DATE")(0).appendChild doc.createTextNode(sDATE)
doc.getElementsByTagName("TYPE")(0).appendChild doc.createTextNode(sTransactionType)
doc.getElementsByTagName("SSCC")(0).appendChild doc.createTextNode(sSSCC)
doc.getElementsByTagName("ORDER")(0).appendChild doc.createTextNode(sORDER)
doc.Save sFile
Next
End With
End Sub
This is an example of the excelsheet:
enter image description here
I would be really happy for some quick help. Thanks in advance.
While your issue is not reproducible, consider some tips that may help you diagnose or resolve your issue:
Use Option Explicit at the very top of module (outside of Sub or Function) to be sure all objects are properly defined. Relatedly, place all Dim objects to top of subroutine or function to help readability.
Incorporate proper error handling with On Error GoTo... to capture runtime exceptions and appropriately exit the sub routine after unsetting objects with or without errors.
Avoid use of ActiveWorkbook and ActiveSheet which can affect workflow if you have many workbooks open. Instead use actually assigned object or ThisWorkbook object. See this canonical Excel post, How to avoid using Select in Excel VBA (where second answer discusses Active* methods).
Try using the early binding version of external libraries like MSXML that can expose useful error properties and enable Intellisense in VBA editor. Currently, you use late binding with CreateObject. If needing late binding for portability among many users, then ignore.
Dim doc As MSXML2.DOMDocument
Set doc = New MSXML2.DOMDocument
When using With blocks, follow through in all its properties. In fact, you can avoid use of ActiveSheet:
sTransactionType = .Name
I have some work to complete where I have 9 tabs of data (some of which contain thousands of lines of data). Each tab contains (amongst others) a policy number, a credit and/or a debit number.
Every policy number will have a match somewhere in the tabs containing an equal credit or debit, e.g.
tab 1 will have Policy number 123 and a credit of £100 and
tab 5 will also have policy number 123 with a debit of £100.
What I'm looking to do is, look through each policy number on every tab and find where the opposite amount is located adding the location address to each policy number.
I'm certainly not looking for anyone to create the coding for me, but what I am looking for is advice. I've looked at using loops but feel this may take a very long time to process. I've also looked at Dictionaries but am relatively new to these so am not very confident.
Is what I'm looking for even possible? And if so any ideas where to start or pointers? Any advice is greatly appreciated. Thanks!
Usage Example
#Matt555, You can test the created XML file with the following code to get the sheet names of policy "123" and debit of 100. I tested the code assuming your titles in row A:A contain "policy" and "debit"
#Peh, You are right, xml dom methods aren't used too often within vba. The advantage of using XML in this connex is a great flexibility in searching via XPath as well as performance over huge files. I prefer it even to arrays or dictionaries when filtering unique values. It is possible to return the found item number in node lists without looping through the whole data set ...
Option Explicit
Sub testPolicy()
Dim policy
Dim debit As Double
policy = "123"
debit = "100"
MsgBox "Policy " & policy & " found in " & vbNewLine & _
findSheetName(policy, debit), vbInformation, "Policy " & policy & " in Tabs"
' You can easily split this to an array and analyze the results
End Sub
Function findSheetName(ByVal policy, Optional ByVal debit) As String
' Purpose: Finds Sheet Names where policy AND/OR debit is found
' Note: Assuming your titles in row A:A contain "policy" and "debit"
' You can declare xDoc also after Option Explicit to make it public
Dim xDoc As Object
Dim xNd As Object ' MSXML.IXMDOMNode
Dim xNdList As Object ' MSXML.IXMLDOMNodeList
Dim s As String
' XPath expression
Dim xPth As String
If IsMissing(debit) Then
xPth = "//row[policy=""" & policy & """]"
Else
xPth = "//row[policy=""" & policy & """][debit=""" & debit & """]"
End If
' XML to memory
Set xDoc = CreateObject("MSXML2.Domdocument.6.0")
' allow XPath
xDoc.setProperty "SelectionLanguage", "XPath"
xDoc.validateOnParse = False
' ========
' LOAD XML
' ========
xDoc.Load ThisWorkbook.Path & "\" & "output.xml"
' Loop thru NodeList
Set xNdList = xDoc.DocumentElement.SelectNodes(xPth)
Debug.Print xPth, xNdList.Length
For Each xNd In xNdList
s = s & xNd.ParentNode.NodeName & "|"
Next xNd
Set xDoc = Nothing
findSheetName = s
End Function
You could
a) create an XML file looping through all sheets,
b) open it via load method and
c) perform a simple XPath search (I can give some examples later)
I modified a recent answer (cf. excel-vba-xml-parsing-performance)
to do step "a)" using late binding thus
a) avoiding a reference to the latest MS XML Version Version 6 (msxml6.dll) and
b) getting data over all xheets. XML allows you structured search via XPath over nodes in a logical structure comparable to HTML. The root node in this example is called data, the following nodes are named with the sheets' names and the subsequent nodes get the names in row A:A of each sheet.
A XML file is a simple text file, which you can open by a text editor. Above all you can use VBA XMLDOM methods to analyze or search through the items (nodes). I will give you examples to relating to your question, but give me some time. => see answer "Usage Example", where I explain some Advantages of XML, too (#Peh).
Please pay Attention to the added notes, too.
Option Explicit
Sub xmlExportSheets()
' Zweck: XML Export over all sheets in workbook
' cf. Site: [excel-vba-xml-parsing-performance][1][https://stackoverflow.com/questions/40986395/excel-vba-xml-parsing-performance/40987237#40987237][1]
' Note: pretty printed raw output with line breaks and indentation using an embedded XSLT stylesheet
On Error GoTo ErrHandle
' A. Declarations
' 1 DECLARE XML DOC OBJECT '
' a) Early Binding: VBA REFERENCE MSXML, v6.0 necessary'
' Dim doc As New MSXML2.DOMDocument60, xslDoc As New MSXML2.DOMDocument60, newDoc As New MSXML2.DOMDocument60
' Dim root As IXMLDOMElement, dataNode As IXMLDOMElement, datesNode As IXMLDOMElement, namesNode As IXMLDOMElement
' b) Late Binding XML Files:
Dim doc As Object
Dim xslDoc As Object
Dim newDoc As Object
' c) Late Binding XML Nodes:
Dim root As Object
Dim sh As Object ' xml node containing Sheet Name
Dim dataNode As Object
Dim datesNode As Object
Dim namesnode As Object
' 2 DECLARE other variables
Dim i As Long
Dim j As Long
Dim tmpValue As Variant
Dim tit As String
Dim ws As Worksheet
' B. XML Docs to Memory
Set doc = CreateObject("MSXML2.Domdocument.6.0")
Set xslDoc = CreateObject("MSXML2.Domdocument.6.0")
Set newDoc = CreateObject("MSXML2.Domdocument.6.0")
' C. Set DocumentElement (= root node)'
Set root = doc.createElement("data")
' D. Create Root Node
doc.appendChild root
' ===========================
' ITERATE THROUGH Sheets
' ===========================
For Each ws In ThisWorkbook.Sheets
Set sh = doc.createElement(ws.Name) '
root.appendChild sh
' ===========================
' ITERATE THROUGH ROWS ' A2:NNn
' ===========================
For i = 2 To ws.UsedRange.Rows.Count ' Sheets(1)
' DATA ROW NODE '
Set dataNode = doc.createElement("row") '
sh.appendChild dataNode
' TABLES NODE (orig.: DATES NODE) '
Set datesNode = doc.createElement(ws.Cells(1, 1)) ' Dates
datesNode.Text = ws.Range("A" & i)
dataNode.appendChild datesNode
' NAMES NODE '
For j = 1 To ws.UsedRange.Columns.Count - 1 ' = 12
tit = ws.Cells(1, j + 1)
tmpValue = ws.Cells(i, j + 1)
Set namesnode = doc.createElement(tit)
namesnode.Text = tmpValue
dataNode.appendChild namesnode
Next j
Next i
Next ws
' =============================
' PRETTY PRINT RAW OUTPUT (XSL)
' =============================
xslDoc.LoadXML "<?xml version=" & Chr(34) & "1.0" & Chr(34) & "?>" _
& "<xsl:stylesheet version=" & Chr(34) & "1.0" & Chr(34) _
& " xmlns:xsl=" & Chr(34) & "http://www.w3.org/1999/XSL/Transform" & Chr(34) & ">" _
& "<xsl:strip-space elements=" & Chr(34) & "*" & Chr(34) & " />" _
& "<xsl:output method=" & Chr(34) & "xml" & Chr(34) & " indent=" & Chr(34) & "yes" & Chr(34) & "" _
& " encoding=" & Chr(34) & "UTF-8" & Chr(34) & "/>" _
& " <xsl:template match=" & Chr(34) & "node() | #*" & Chr(34) & ">" _
& " <xsl:copy>" _
& " <xsl:apply-templates select=" & Chr(34) & "node() | #*" & Chr(34) & " />" _
& " </xsl:copy>" _
& " </xsl:template>" _
& "</xsl:stylesheet>"
' XSLT (Transformation)
xslDoc.async = False
doc.transformNodeToObject xslDoc, newDoc
' =================
' Save the XML File
' =================
newDoc.Save ThisWorkbook.Path & "\Output.xml"
MsgBox "Successfully exported Excel data to " & ThisWorkbook.Path & "\Output.XML!", vbInformation
' Regular End of procedure
Exit Sub
ErrHandle:
MsgBox Err.Number & " - " & Err.Description, vbCritical
Exit Sub
End Sub
Note
Sheet names have to be without spaces
Added Note (important hint):
XML Nodes use titles in first row of every sheet. As the modified procedure gets title names via UsedRange it's important not to have any empty cells in row A:A for this example.
Additional remark
I don't know the reason why my prompt answer (marked as "a") was downgraded by someone. I would find it helpful to argue this :-)
I have this simple VBA code below, and I don't know why is not working.
Sub Run()
test = "MsgBox" & """" & "Job Done!" & """"
Application.Run test
End Sub
What I want to do is to put the VBA Command into a variable as text and run it as a command. In this case, I want to run like MsgBox "Job Done!" and print just:
Job Done!
You may be tempted by adding your own string "Executer":
Sub StringExecute(s As String)
Dim vbComp As Object
Set vbComp = ThisWorkbook.VBProject.VBComponents.Add(1)
vbComp.CodeModule.AddFromString "Sub foo()" & vbCrLf & s & vbCrLf & "End Sub"
Application.Run vbComp.name & ".foo"
ThisWorkbook.VBProject.VBComponents.Remove vbComp
End Sub
Sub Testing()
StringExecute "MsgBox" & """" & "Job Done!" & """"
End Sub
Short answer is, you cannot do that (You should not do that) but ... read the following to find out why and see a work around!
As you know you are writing your code in a compiler. What you want to do is running human-legible line of text as a command which is not possible. While you run the program all of it is compiled to machine language. When you pass that line of text to it, it cannot recognize it as a command and you will end up getting an error. What you can do is passing arguments to it:
Sub Run()
test = "Job Done"
MsgBox(test)
End Sub
You can also run an executable which can be written as a text file within a macro and then runs within the same Sub (extension needs to be taken care of).
If you cannot change the variable (i.e. test) then you need to take another approach towards it. I would suggest something like extracting the argument which can be passed to the function and use that. Something like below;
Sub Run()
test = "MsgBox" & """" & "Job Done!" & """"
extest = Right(test, Len(test) - 7)
MsgBox (extest)
End Sub
I believe there was a same question on SO but I couldn't find it. I will included it as a reference if found it.
P.S. These two posts may help to find an answer:
Access VBA - Evaluate function with string arguments
Excel VBA - How to run a string as a line of code
ANOTHER SOLUTION
This needs to trust the VB project. Quoting from ExcelForum and referencing to Programmatic Access To Visual Basic Project Is Not Trusted - Excel
Quote:
Place your Macro-Enabled Workbook in a folder which you can designate
as macro friendly.
Then open the workbook.
Click on the Office Button -> Excel Options ->
Trust Center -> Trust Center Setting -> Trusted Locations.
Then you add your folder (where you have your Excel Macro-Enabled Workbook) as
a trusted location.
Also you need to do this:
File -> Options -> Trust Center -> Trust Center Setting -> Macro Setting ->
Check the box beside "Trust access to the VBA project object model"
Close and re-open your workbook.
Those who use your macro should go through the same steps.
Unquote.
Then you can use this which I got from VBA - Execute string as command in Excel (This is not tested)
Sub test()
Set VBComp = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_StdModule)
VBComp.Name = "NewModule"
Set VBCodeMod = ThisWorkbook.VBProject.VBComponents("NewModule").CodeModule
Dim test As String
test = "MsgBox " & """" & "Job Done!" & """"
With VBCodeMod
LineNum = .CountOfLines + 1
.InsertLines LineNum, _
"Sub MyNewProcedure()" & Chr(13) & test & Chr(13) & "End Sub"
End With
'run the new module
Application.Run "MyNewProcedure"
UserForm1.Show
'Delete the created module
ThisWorkbook.VBProject.VBComponents.Remove VBComp
End Sub
#A.S.H answer does the thing that last solution intends to implement. I am including it here for the sake of completeness. You can refer to the original answer and up-vote it.
Public Sub StringExecute(s As String)
Dim vbComp As Object
Set vbComp = ThisWorkbook.VBProject.VBComponents.Add(1)
vbComp.CodeModule.AddFromString "Sub foo" & vbCrLf & s & vbCrLf & "End Sub"
Application.Run vbComp.name & ".foo"
ThisWorkbook.VBProject.VBComponents.Remove vbComp
End Sub
Sub Testing()
StringExecute "MsgBox" & """" & "Job Done!" & """"
End Sub
If you need a solution which doesn't require special permissions, and has significantly more power than hard coding code, I maintain a library, stdLambda from stdVBA, for this kind of thing:
'Ensure module name is "mainModule"
Public Sub Main()
Call stdLambda.bindGlobal("msgbox", stdCallback.CreateFromModule("mainModule","msgbox"))
x = stdLambda.Create("msgbox(""hello world"")").Run()
End Sub
Public Function msgbox(ByVal sMessage as string) as long
msgbox = VBA.msgbox(sMessage)
End Function
stdLambda syntax is vba-like but is a fully embedded programming language in its own right. See the documentation for more details.
I was up against a similar variation: the macro name was in a 'control specification' worksheet table. A custom ribbon was added with an 'onAction' parameter in the ribbon XML. The 'tag' Name was returned in the Ribbon call back macro that was then used to lookup the macro Name to run based on the XML tag name. Makes sense so far!!!! I already had the handling subs in an existing Code Module=[m0_RibbonCallBack]. In the [m0_RibbonCallBack] module I wanted to run the sub name=[mResetToCellA2] when I clicked the ribbon button with tagName=[Reset2CellA2]. In the 'control specification' worksheet table I did a vLookUp() on the tagname=[Reset2CellA2] and returned the string value from column 3 (onAction) ="mResetToCellA2". Now I need to run the macro string (macroName) name on the VBA side!!!
I wound up solving the challenge with this simple line:
Application.Run "m0_RibbonCallBack." & macroName
Cheers!
I wanted to extract list of defects using a filter criteria. I tried the VBA code from OTA here, but compile fails on the following declarations with User defined type not defined:
Dim BugFact As BugFactory
Dim BugFilter As TDFilter
Dim bugList As List
Dim theBug As Bug
Note: I do not have administrative privileges on ALM.
The full VBA code:
Sub BugFilter()
Dim BugFact As BugFactory
Dim BugFilter As TDFilter
Dim bugList As List
Dim theBug As Bug
Dim i%, msg$
' Get the bug factory filter.
'tdc is the global TDConnection object.
Set BugFact = tdc.BugFactory
Set BugFilter = BugFact.Filter
' Set the filter values.
BugFilter.Filter("BG_STATUS") = "Closed"
BugFilter.order("BG_PRIORITY") = 1
MsgBox BugFilter.Text
'Create a list of defects from the filter
' and show a few of them.
Set bugList = BugFilter.NewList
msg = "Number of defects = " & bugList.Count & Chr(13)
For Each theBug In bugList
msg = msg & theBug.ID & ", " & theBug.Summary & ", " _
& theBug.Status & ", " & theBug.Priority & Chr(13)
i = i + 1
If i > 10 Then Exit For
Next
MsgBox msg
End Sub
You need to add a reference to the OTA COM Type library (see here); otherwise your program will not know about the OTA types such as BugFactory and TDFilter.