Приложение Excel VBA.sendkeys "^C", правда не работает

Я использую Excel VBA для копирования выделения текста из файла Access (я бы предпочел не вдаваться в подробности о том, почему). У меня есть это в цикле Do While, который ДОЛЖЕН нажать клавишу табуляции (работает), затем скопировать данные (не удается), поместить их в буфер обмена (работает) и установить информацию о буфере обмена в переменную (работает), которая затем, в целях отладки делает debug.print переменной (работает). Это для циклического перемещения по форме, чтобы добраться до "базовой точки", где я могу на 100% использовать вкладки и тому подобное для перехода к другим частям формы. Смотрите код пожалуйста:

AppActivate ("Microsoft Access - Filename that is constant")

X = 0
Do While X < 14
Application.SendKeys "{TAB}", True
Application.SendKeys "^C", True

Sleep (500)

mydata.GetFromClipboard
cb = mydata.GetText

Debug.Print (cb)
If Len(cb) = 5 Then
X = 14
End If
X = X + 1
Loop
Set mydata = Nothing

Я пытался заставить это работать, но безрезультатно. Что я делаю не так или, возможно, что будет лучшим решением?

Источник

2 ответа

Решение

Я понял. Я скопировал код отсюда: http://www.vbaexpress.com/forum/showthread.php?38826-SendInput()-in-Excel-64Bit Я изменил VkkeyMenu на VbKeyControl и клавишу "f" на "C". Я знаю, что это может быть упрощено, чтобы занимать меньше строк, но я бы предпочел не связываться с ним, если он работает как поговорка "Если это не сломано, не исправляйте это". Код:

Private Declare PtrSafe Function SendInput Lib "user32" (ByVal nInputs As LongPtr, pInputs As Any, ByVal cbSize As LongPtr) As LongPtr
Private Declare PtrSafe Function VkKeyScan Lib "user32" Alias "VkKeyScanA" (ByVal cChar As Byte) As Integer
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Type KeyboardInput '   creating variable type
dwType As Long '   input type (keyboard or mouse)
wVk As Integer '   the key to press/release as ASCSI scan code
wScan As Integer '   not required
dwFlags As Long '   specify if key is pressed or released
dwTime As Long '   not required
dwExtraInfo As Long '   not required
dwPadding As Currency '   only required for mouse inputs
End Type



' SendInput constants
Private Const INPUT_KEYBOARD As Long = 1


Private Const KEYEVENTF_EXTENDEDKEY As Long = 1
Private Const KEYEVENTF_KEYUP As Long = 2


' Member variables


Private TheKeys() As KeyboardInput
Private NEvents As Long




Sub testage()


ReDim TheKeys(0 To 3)


With TheKeys(0)

    .dwType = INPUT_KEYBOARD 'operation type
    .wVk = vbKeyControl 'press CTRL key

End With


With TheKeys(1)


    .dwType = INPUT_KEYBOARD ' operation
    .wVk = VkKeyScan(Asc("C")) 'press chr key

End With


With TheKeys(2)

    .dwType = INPUT_KEYBOARD 'operation type
    .wVk = VkKeyScan(Asc("C"))
    .dwFlags = KEYEVENTF_KEYUP 'release chr key

End With


With TheKeys(3)


    .dwType = INPUT_KEYBOARD ' operation type
    .wVk = vbKeyControl
    .dwFlags = KEYEVENTF_KEYUP 'release CTRL Key


End With
Call SendInput(4, TheKeys(0), Len(TheKeys(0)))


Erase TheKeys


End Sub
Источник

Хотя я ненавижу Sendkeys и задавался вопросом, должен ли я спросить вас об этом, но так как вы сказали не спрашивать почему, я буду держать свою ловушку закрытой.:П

Попробуйте это небольшое исправление... Если это сработает, значит, вам нужно дать ему немного времени перед выполнением следующей команды sendkeys.

Sub Sample()
    '
    '~~> Rest of your code
    '

    Application.SendKeys "{TAB}", True

    Wait 2

    Application.SendKeys "^{C}", True

    '
    '~~> Rest of your code
    '
End Sub

Private Sub Wait(ByVal nSec As Long)
    nSec = nSec + Timer
    While nSec > Timer
        DoEvents
    Wend
End Sub

что было бы лучшим решением?

Используйте API, как показано здесь. Это не дает прямого ответа на ваш вопрос, но объясняет, как работает концепция.

Так что применять это было бы что-то вроде этого

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Dim Ret As Long

Sub Sample()
    Ret = FindWindow(vbNullString, "Microsoft Access - Filename that is constant")

    If Ret <> 0 Then
        MsgBox "Window Found"
    Else
        MsgBox "Window Not Found"
    End If
End Sub

Если вы хотите стать хорошим в API, как FindWindow, FindWindowEx а также SendMessage затем получите инструмент, который дает вам графическое представление о системных процессах, потоках, окнах и оконных сообщениях. Например: uuSpy или же Spy++, Еще один пример, который демонстрирует, как используется этот API.

Источник
Другие вопросы по тегам