Get treeview item information using VBA

Test Partner is quite flexible in handling treeview control. But there are times when you need to have a finer control of the object. The purpose of this blogpost is to document how to get treeview item information using Win32 api.

The code below is a class module that now supports getting the text of root and currently selected item. It also allows the user to check whether the item is expanded or not. See below for the code. For demonstration purposes, save this as TWin32TreeView class module under common project (I am referring to Test Partner here).

	Option Explicit
	'References:
	'http://msdn.microsoft.com/en-us/library/bb759988(VS.85).aspx
	'http://www.xtremevbtalk.com/showthread.php?t=45515
	'http://www.tek-tips.com/viewthread.cfm?qid=344761&page=8
	'Get items across process boundaries
	'http://www.codeproject.com/KB/threads/int64_memsteal.aspx?fid=29535&df=90&mpp=25&noise=3&sort=Position&view=Quick&select=2558283&fr=26
	'http://www.autoitscript.com/forum/lofiversion/index.php?t9988.html
	'Getting text from GetLastError
	'http://support.microsoft.com/kb/186063
	'How To List Running Processes
	'http://support.microsoft.com/kb/187913
	'problem using LVM_SETTEXTBKCOLOR to change color listview text
	'http://www.programmersheaven.com/mb/VBasic/340733/340733/ReadMessage.aspx
	'GetCommandLine win32 function for VB/VBA
	'http://www.motobit.com/tips/detpg_vba-getcommandline/
	Private Const TVGN_ROOT As Long = &H0
	Private Const TVGN_CARET As Long = &H9
	'// TreeView messages
	Private Const TV_FIRST As Long = &H1100
	Private Const TVM_GETCOUNT As Long = (TV_FIRST + 5)
	Private Const TVM_GETNEXTITEM As Long = (TV_FIRST + 10)
	Private Const TVM_SELECTITEM As Long = (TV_FIRST + 11)
	Private Const TVM_GETITEM As Long = (TV_FIRST + 12) 'this is assuming non-UNICODE
	Private Const TVM_ENSUREVISIBLE As Long = (TV_FIRST + 20)
	Private Const TVM_GETITEMSTATE As Long = (TV_FIRST + 39)
	'TreeView item mask
	Private Const TVIF_TEXT = &H1
	Private Const TVIF_STATE = &H8
	Private Const TVIF_HANDLE = &H10
	Private Const TVIF_CHILDREN = &H40
	'Treeview statemask
	Private Const TVIS_EXPANDED = &H20
	Private Const MAXTEXTLEN = 50 'max length per item in tree view
	Private m_hwnd As Long
	'//process related
	Private Const PROCESS_VM_OPERATION As Integer = &H8
	Private Const PROCESS_VM_READ As Integer = &H10
	Private Const PROCESS_VM_WRITE As Integer = &H20
	Private Const PROCESS_QUERY_INFORMATION As Integer = &H400
	Private Const MEM_COMMIT = &H1000&
	Private Const MEM_RESERVE = &H2000&
	Private Const MEM_RELEASE = &H8000&
	Private Const PAGE_READWRITE = &H4&
	Private Type TVITEM 'was TV_ITEM
	mask As Long
	hItem As Long
	state As Long
	stateMask As Long
	pszText As Long 'pointer to string
	cchTextMax As Long
	iImage As Long
	iSelectedImage As Long
	cChildren As Long
	lParam As Long
	End Type
	Private Type TVITEMEX
	mask As Long
	hItem As Long
	state As Long
	stateMask As Long
	pszText As Long 'pointer to string
	cchTextMax As Long
	iImage As Long
	iSelectedImage As Long
	cChildren As Long
	lParam As Long
	iIntegral As Long
	#If (WIN32_IE >= &H600) Then
	uStateEx As Long
	hwnd As Long
	iExpandedImage As Long
	#End If
	End Type
	Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
	Private Declare Function FormatMessage Lib "kernel32" Alias _
	"FormatMessageA" (ByVal dwFlags As Long, lpSource As Long, _
	ByVal dwMessageId As Long, ByVal dwLanguageId As Long, _
	ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Any) _
	As Long
	Private Declare Function SendMessageAny Lib "user32" _
	Alias "SendMessageA" _
	(ByVal hwnd As Long, _
	ByVal wMsg As Long, _
	ByVal wParam As Any, _
	lParam As Any) As Long
	Private Declare Function GetWindowThreadProcessId Lib "user32" _
	(ByVal hwnd As Long, lpdwprocessid As Long) As Long
	Private Declare Function OpenProcess Lib "kernel32.dll" _
	(ByVal dwAccess As Long, _
	ByVal fInherit As Integer, _
	ByVal hObject As Long) As Long
	Private Declare Function CloseHandle Lib "kernel32" _
	(ByVal hObject As Long) As Long
	Private Declare Function VirtualAllocEx Lib "kernel32" _
	(ByVal hProcess As Long, lpAddress As Any, _
	ByVal dwSize As Long, _
	ByVal flAllocationType As Long, _
	ByVal flProtect As Long) As Long
	Private Declare Function VirtualFreeEx Lib "kernel32" _
	(ByVal hProcess As Long, _
	lpAddress As Any, _
	ByVal dwSize As Long, _
	ByVal dwFreeType As Long) As Long
	Private Declare Function WriteProcessMemory Lib "kernel32" _
	(ByVal hProcess As Long, _
	lpBaseAddress As Any, _
	lpBuffer As Any, _
	ByVal nSize As Long, _
	lpNumberOfBytesWritten As Long) As Long
	Private Declare Function ReadProcessMemory Lib "kernel32" _
	(ByVal hProcess As Long, _
	lpBaseAddress As Any, _
	lpBuffer As Any, _
	ByVal nSize As Long, _
	lpNumberOfBytesWritten As Long) As Long
	Private Declare Function lstrcpyn_long_string Lib "kernel32" _
	Alias "lstrcpynA" (ByVal DestString As String, _
	ByVal SourcePointer As Long, _
	ByVal MaxLen As Long) As Long
	Private Declare Function lstrlen_long Lib "kernel32" _
	Alias "lstrlenA" (ByVal SourcePointer As Long) As Long
	'this black magic functions are not yet being used
	Private Declare Function GetProcessHeap Lib "kernel32" () As Long
	Private Declare Function HeapAlloc Lib "kernel32" _
	(ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
	Private Declare Function HeapFree Lib "kernel32" _
	(ByVal hHeap As Long, _
	ByVal dwFlags As Long, _
	lpMem As Any) As Long
	Private Declare Sub CopyMemoryWrite Lib "kernel32" _
	Alias "RtlMoveMemory" _
	(ByVal Destination As Long, _
	Source As Any, ByVal Length As Long)
	Private Function MessageText(lCode As Long) As String
	Dim sRtrnCode As String
	Dim lret As Long
	sRtrnCode = Space$(256)
	lret = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0&, lCode, 0&, _
	sRtrnCode, 256&, 0&)
	If lret > 0 Then
	MessageText = Left(sRtrnCode, lret)
	Else
	MessageText = "Error not found."
	End If
	End Function
	Public Property Let Handle(l_hwnd As Long)
	m_hwnd = l_hwnd
	OutputDebugString "YH:- Handle: " & CStr(m_hwnd)
	End Property
	Public Property Get Count() As Long
	Dim lResult As Long
	lResult = SendMessage(m_hwnd, TVM_GETCOUNT, 0, 0)
	Count = lResult
	End Property
	Public Function MoveToRoot()
	Dim lResult As Long
	lResult = SendMessageAny(m_hwnd, TVM_GETNEXTITEM, TVGN_ROOT, 0&)
	'Note: Very important
	'Since lResult is already a pointer to a memory
	'we need to pass the value into the stack as is, not the address hence using ByVal instead of ByRef
	Call SendMessageAny(m_hwnd, TVM_SELECTITEM, TVGN_CARET, ByVal lResult)
	End Function
	Public Function GetRootItemText() As String 'TVITEM
	Dim pid As Long
	Dim process As Long
	Dim tv_item As TVITEM
	Dim ptv_item As Long 'pointer to tv_item
	Dim pitemsz As Long 'Pointer to pz
	Dim pitem_root As Long 'pointer to tv_item for the root node
	Dim sRet As String
	Call GetWindowThreadProcessId(m_hwnd, pid)
	process = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE Or PROCESS_QUERY_INFORMATION, 0, pid)
	If process > 0 Then
	ptv_item = VirtualAllocEx(process, 0, LenB(tv_item), MEM_COMMIT, PAGE_READWRITE)
	pitemsz = VirtualAllocEx(process, 0, MAXTEXTLEN, MEM_COMMIT, PAGE_READWRITE)
	pitem_root = SendMessageAny(m_hwnd, TVM_GETNEXTITEM, TVGN_ROOT, 0&)
	If pitem_root <> 0 Then
	tv_item.cchTextMax = MAXTEXTLEN
	tv_item.hItem = pitem_root
	'tv_item.mask = TVIF_TEXT Or TVIF_CHILDREN
	tv_item.mask = TVIF_TEXT Or TVIF_HANDLE
	tv_item.pszText = pitemsz
	Dim lpWritten As Long
	Dim lret As Long
	lret = WriteProcessMemory(process, ByVal ptv_item, tv_item, LenB(tv_item), lpWritten)
	If lret = 0 Then
	OutputDebugString "YH: -o- WriteProcessMemory returned 0 "
	End If
	Call SendMessageAny(m_hwnd, TVM_GETITEM, 0&, ByVal ptv_item)
	Dim buf() As Byte
	ReDim buf(MAXTEXTLEN)
	lret = ReadProcessMemory(process, ByVal pitemsz, buf(0), MAXTEXTLEN, lpWritten)
	OutputDebugString "YH: -o- lpwritten > " & CStr(lpWritten)
	Dim index As Long
	Dim tmpstring As String
	For index = LBound(buf) To UBound(buf)
	If Chr(buf(index)) = vbNullChar Then Exit For
	tmpstring = tmpstring & Chr(buf(index))
	Next index
	sRet = tmpstring
	OutputDebugString "YH: -o- " & tmpstring
	End If
	End If
	VirtualFreeEx process, ByVal pitemsz, MAXTEXTLEN, MEM_RELEASE
	VirtualFreeEx process, ByVal tv_item, LenB(tv_item), MEM_RELEASE
	CloseHandle process
	GetRootItemText = sRet
	End Function
	'Note: Use TVGN_CARET flag of TVM_GETNEXTITEM to get the currently selected item
	Public Function GetSelectedItemText() As String
	Dim pid As Long
	Dim process As Long
	Dim tv_item As TVITEM
	Dim ptv_item As Long 'pointer to tv_item
	Dim pitemsz As Long 'Pointer to pz
	Dim pitem_selected As Long 'pointer to tv_item for the selected item
	Dim sRet As String 'return string
	Call GetWindowThreadProcessId(m_hwnd, pid)
	process = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE Or PROCESS_QUERY_INFORMATION, 0, pid)
	If process > 0 Then
	ptv_item = VirtualAllocEx(process, 0, LenB(tv_item), MEM_COMMIT, PAGE_READWRITE)
	pitemsz = VirtualAllocEx(process, 0, MAXTEXTLEN, MEM_COMMIT, PAGE_READWRITE)
	'get pointer to item object
	pitem_selected = SendMessageAny(m_hwnd, TVM_GETNEXTITEM, TVGN_CARET, 0&)
	If pitem_selected <> 0 Then
	tv_item.cchTextMax = MAXTEXTLEN
	tv_item.hItem = pitem_selected
	tv_item.mask = TVIF_TEXT Or TVIF_HANDLE
	tv_item.pszText = pitemsz
	Dim lpWritten As Long
	Dim lret As Long
	lret = WriteProcessMemory(process, ByVal ptv_item, tv_item, LenB(tv_item), lpWritten)
	If lret = 0 Then
	OutputDebugString "YH: -o- WriteProcessMemory returned 0 "
	End If
	'Now get ptv_item populated with data
	Call SendMessageAny(m_hwnd, TVM_GETITEM, 0&, ByVal ptv_item)
	Dim buf() As Byte
	ReDim buf(MAXTEXTLEN)
	lret = ReadProcessMemory(process, ByVal pitemsz, buf(0), MAXTEXTLEN, lpWritten)
	OutputDebugString "YH: -o- lpwritten > " & CStr(lpWritten)
	Dim index As Long
	Dim tmpstring As String
	For index = LBound(buf) To UBound(buf)
	If Chr(buf(index)) = vbNullChar Then Exit For
	tmpstring = tmpstring & Chr(buf(index))
	Next index
	sRet = tmpstring
	OutputDebugString "YH: -o- " & tmpstring
	End If
	End If
	VirtualFreeEx process, ByVal pitemsz, MAXTEXTLEN, MEM_RELEASE
	VirtualFreeEx process, ByVal tv_item, LenB(tv_item), MEM_RELEASE
	CloseHandle process
	GetSelectedItemText = sRet
	End Function
	'Note: Use TVM_GETITEMSTATE message with stateMask set to TVIS_EXPANDED
	Public Function IsSelectedItemExpanded() As Boolean
	Dim pitem_selected As Long 'pointer to tv_item for the selected item
	Dim bRet As Boolean
	pitem_selected = SendMessageAny(m_hwnd, TVM_GETNEXTITEM, TVGN_CARET, 0&)
	Dim lItemState As Long
	lItemState = SendMessageAny(m_hwnd, TVM_GETITEMSTATE, ByVal pitem_selected, TVIS_EXPANDED)
	If (lItemState And TVIS_EXPANDED) = TVIS_EXPANDED Then
	bRet = True
	Else
	bRet = False
	End If
	IsSelectedItemExpanded = bRet
	End Function

view raw TWin32TreeView.bas hosted with ❤ by GitHub

Below is a sample test script to use the class module. You can save this as "scratch" under common project.

	Option Explicit
	Sub Main()
	Include "Common.TWin32TreeView"
	Dim wtv As TWin32TreeView
	'Window("Desktop Window").Attach
	Window("Application=Explorer.exe ClassName=CabinetWClass TypeName=Window").Attach
	Set wtv = New TWin32TreeView
	wtv.Handle = TreeView("Index=1").hwnd
	Dim sMsg As String
	sMsg = "Root item is " & wtv.GetRootItemText
	sMsg = sMsg & vbCrLf & "Selected item is : " & wtv.GetSelectedItemText
	MsgBox sMsg
	If wtv.IsSelectedItemExpanded Then
	MsgBox "selected node is expanded"
	Else
	MsgBox "it is not yet expanded"
	End If
	End Sub

view raw TWin32TreeViewDemo.bas hosted with ❤ by GitHub

Enjoy!

Note: For better result, use Notepad++ when copying source code from clipboard. The builtin Notepad.exe is not up to the job.

You may check latest copy from http://tscodesnippets.googlecode.com/svn/tpcodesnippets/trunk/ or browse source from svn repository here.

TechnoS