Clipboard мониторинг, чтение

#If VBA7 Then ' проверяем, что используется 64-битная версия VBA
    Private Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hWnd As LongPtr) As LongPtr ' объявляем функцию API для установки фокуса на окно
    Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As LongPtr, ByVal nCmdShow As Long) As LongPtr ' объявляем функцию API для показа окна
#Else ' для 32-битной версии VBA
    Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long ' объявляем функцию API для установки фокуса на окно
    Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long ' объявляем функцию API для показа окна
#End If
Dim buffer(1 To 2) As String ' храним последнии состояния буфера обмена
Sub Кнопка1_Щелчок()
    SetClipboardText ("") ' очищаем буфер обмена
    buffer(1) = "" ' текст из буфера обмена в переменную (очищаем попросту)
 
    Do ' в цикле с задержкой в 2 секунды проверяем содержимое буфера обмена и сравниваем с эталоном
        Application.Wait (Now + TimeValue("0:00:02")) ' пауза в 1 сек вызывает ошибку
        buffer(2) = ClipboardText() ' читаем буфер обмена
        If (buffer(2) <> buffer(1)) And (Len(buffer(2)) <> 2) Then ' сравнимаем результат с последним состоянием буфера обмена
            ActiveCell = Replace(Replace(Trim(buffer(2)), vbLf, " "), "  ", " ") ' буфер обмена изменился, сохраняем текст буфера в текущую ячейку убираем переносы строк и двойные пробелы
            buffer(1) = buffer(2) ' сохраняем текущее состояние буфера обмена
            Cells(ActiveCell.Row + 1, ActiveCell.Column).Select ' переходим на следующую ячейку
        End If
    Loop While (Len(buffer(2)) <> 2) ' делаем пока длинна текста в буфере обмена не будет равна двум символам
 
    'Beep 500, 300
    SetForegroundWindow Application.hWnd ' устанавливаем фокус на окно Excel
    ShowWindow Application.hWnd, vbMinimizedFocus ' сворачиваем окно Excel
End Sub
 
Function ClipboardText() ' чтение из буфера обмена
    With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .GetFromClipboard
        ClipboardText = .GetText
    End With
End Function
 
Sub SetClipboardText(ByVal txt$) ' запись в буфер обмена
    With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .SetText txt$
        .PutInClipboard
    End With
End Sub

Sub StartCleapMonitor()
    With ThisWorkbook.Sheets(1)
        Set curCell = .Cells(.Cells(2), 1)
    End With
    Set dataObj = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") 'Set dataObj = New MSForms.DataObject
    clpmOn = 1
    CleapMonitor
End Sub
Sub StopCleapMonitor()
    clpmOn = 0
End Sub
Sub CleapMonitor()
    Static oldClp$
    Dim Clp$, ln&
    If clpmOn = 0 Then Exit Sub
    DoEvents
    If Application.ClipboardFormats(1) = 0 Then    'проверка наличия текста в б/о
        dataObj.GetFromClipboard
'        if dataObj.GetFormat(1) =True then        'второй способ проверки наличия текста в б/о
        Clp = dataObj.GetText
        ln = Len(Clp)
        If ln Then
            If ln = 2& Then Exit Sub               'отключение слежки если 2 символа
            If Clp <> oldClp Then
                With curCell '                     'запись текста в ячейку
                    .Value = Clp
                    .WrapText = False
                End With
                Set curCell = curCell.Offset(1)
                oldClp = Clp
            End If
            dataObj.Clear
            dataObj.SetText ""
            dataObj.PutInClipboard                 'очистка буфера
        End If
    End If
    Application.OnTime Now + TimeValue("00:00:01"), "CleapMonitor"
End Sub