Пишу в стандартном модуле:
- Код: Выделить всё
Option Explicit
Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Integer
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const LANG_NEUTRAL = &H0
Sub test()
EnumWindows AddressOf EnumWindowsProc, ByVal 0&
End Sub
Private Function EnumWindowsProc(hwnd As Long, lParam As Long) As Boolean
Dim nTextLen As Long
Dim sWinText As String
Dim sClassName As String
Dim RetVal As Long
Dim err_buffer As String: err_buffer = Space(200)
nTextLen = GetWindowTextLength(hwnd)
If nTextLen = 0 Then
FormatMessage FORMAT_MESSAGE_FROM_SYSTEM, 0, GetLastError, LANG_NEUTRAL, err_buffer, 200, 0
Debug.Print err_buffer & vbTab & "Ошибка Dll: " & CStr(Err.LastDllError)
End If
sWinText = Space(nTextLen)
RetVal = GetWindowText(hwnd, sWinText, nTextLen + 1)
If RetVal = 0 Then
FormatMessage FORMAT_MESSAGE_FROM_SYSTEM, 0, GetLastError, LANG_NEUTRAL, err_buffer, 200, 0
Debug.Print err_buffer & vbTab & "Ошибка Dll: " & Err.LastDllError
End If
RetVal = GetClassName(hwnd, sClassName, 255)
If RetVal <> 0 Then
sClassName = Left(sClassName, RetVal)
Debug.Print "Дескриптор: &H" & Hex(hwnd) & vbTab & _
"Текст окна: """ & sWinText & """" & vbTab & _
"Имя класса: """ & sClassName & """"
EnumWindowsProc = True
End If
End Function
Но код виснет на 4-5 проходе и ворд слетает с ошибкой. В VB6 все работает. В чем причина?
Ошибки я стал ловить уже от отчаяния, целый день мучаюсь. Нужно именно в VBA сделать.