Fange tekst fra en aktiv dialogboks

Tags:    visual-basic

Nedenstående kode medfører at jeg kan fange alt tekst fra skrivebordet og lægge det i en wordfil. Er der nogen der kan fortælle mig hvordan jeg ændre koden, således jeg istedet for at fange alt tekst fra skriveborden kan fange teksten fra en aktiv dialogboks, hvor nogle af tekstfelterne ændre sig med tid eller ligende.....

Nedensående kode er taget fra følgende hjemmeside:http://www.skesoft.com/textcatch.htm
-------------------------------------------------------
Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmd As Long) As Long

Const GW_CHILD = 5

Private hWndDesktopListView As Long


Public Function EnumFunc(ByVal hwnd As Long, ByVal lParam As Long) As Long
Dim ClsName As String
Dim len5 As Long
If hwnd = 0 Then
EnumFunc = 0
Else
ClsName = String(255, 0)
len5 = GetClassName(hwnd, ClsName, 256)
ClsName = Left(ClsName, len5)

If ClsName = "Progman" Then
Dim hChild
hChild = GetWindow(hwnd, GW_CHILD)
hChild = GetWindow(hChild, GW_CHILD)

If hChild <> 0 Then
ClsName = String(255, 0)
len5 = GetClassName(hChild, ClsName, 256)
ClsName = Left(ClsName, len5)

If ClsName = "SysListView32" Then
hWndDesktopListView = hChild
EnumFunc = 0
End If
End If
Else
EnumFunc = 1
End If
End If
End Function


Sub TextCatchSample()
'
' TextCatchSample Macro
'

Dim hWndDesktop As Long
Dim TcServer As Object
Dim str As String

hWndDesktop = GetDesktopWindow
If hWndDesktop = 0 Then
MsgBox "Can't get desktop window handle"
Exit Sub
End If

hWndDesktopListView = 0

Call EnumChildWindows(hWndDesktop, AddressOf EnumFunc, 0)

If hWndDesktopListView = 0 Then
MsgBox "Don't find desktop listview control"
Exit Sub
End If

Set TcServer = CreateObject("TextCatch.TcServer")
TcServer.GetFromHandle hWndDesktopListView, ct_Auto, str
' MsgBox str
' Create new document.
' Documents.Add Template:="normal"
With Selection
.Font.Name = "times new roman"
.Font.Bold = False
' Insert result here
.TypeText str
End With

Set TcServer = Nothing
Selection.TypeParagraph
Selection.TypeParagraph
Selection.InsertDateTime DateTimeFormat:="dd-MM-yyyy HH:mm:ss", _
InsertAsField:=False, DateLanguage:=wdDanish, CalendarType:= _
wdCalendarWestern, InsertAsFullWidth:=False
Selection.TypeParagraph
Selection.TypeParagraph
End Sub
-------------------------------------



Indlæg senest redigeret d. 12.06.2007 22:27 af Bruger #11987
t