Parent page: Service Functions – Excel (QTP, VBScript)

Answers

Description

Connect to Excel through COM – Open workbook – Retrieve Code Module object – Retrieve Code Block string – Parse the string – close and save the workbook.

Notes.

For this example let’s assume our target Workbook is stored as “C:\Temp\1.xls”, and our target Code Module is named “Module1”, and we’re looking for “Public” macros only.

QTP/VBScript source code

Set XLHandle =  CreateObject("Excel.Application")
XLHandle.DisplayAlerts = False
   
Set XLBook = XLHandle.WorkBooks.Open("c:\temp\1.xls")
Set objCodeModule = XLBook.VBProject.VBComponents.Item("Module1").CodeModule
sCodeBlock = objCodeModule.Lines(1, objCodeModule.CountOfLines)

'sCodeBlock now contains the all code lines from Module1

Set objMacros = CreateObject("Scripting.Dictionary")

'Here we'll store captured macro declarations

intStart = 1

Do While True
 intIndex = InStr(intStart, sCodeBlock, "public", vbTextCompare)
 If intIndex = 0 Then
  Exit Do
 End If

 intLineEnd = InStr(intIndex, sCodeBlock, VbCrLf, vbTextCompare)
 sHeader = Mid(sCodeBlock, intIndex, intLineEnd-intIndex+2)
 objMacros.Add objMacros.Count+1, sHeader

 intStart = intIndex + 1
Loop
'See sample Excel VBA Code Module below
'objMacros.Item(1) contains "Public Function TestFunction()"

'objMacros.Item(2) contains "Public Function TestFunction2(ByVal intRow)"

'objMacros.Item(3) contains "Public Sub TestSub()"

XLBook.Save
XLBook.Close

XLHandle.Quit

Set objMacros = Nothing
Set objCodeModule = Nothing

Set XLBook = Nothing
Set XLHandle = Nothing

Excel/VBA source code

Public Function TestFunction()
 Sheet1.Cells(1, 1) = "Executed function"
End Function

Public Function TestFunction2(ByVal intRow)
 Sheet1.Cells(intRow, 1) = "Changed Row " & intRow
End Function

Public Sub TestSub()
 Sheet1.Cells(2, 1) = "Executed sub"

End Sub