Почему моя экранная клавиатура активируется во время этого кода? - PullRequest
0 голосов
/ 27 января 2020

Я добавил этот код в свой макрос для автоматического взаимодействия с существующим окном IE. Он отлично работает и выполняет то, что я пытаюсь выполнить sh, но по какой-то причине каждый раз, когда я запускаю этот код, он активирует мою блокировку клавиатуры на экране, которая отключает клавишу "-" в правом верхнем углу на панели ввода номеров. , и единственный способ заставить эту клавишу работать снова - это открыть мою экранную клавиатуру и нажать num lock. Любая помощь, исправляющая это было бы здорово.

If Cells(19, "AB").Value = False And Cells(20, "AB").Value = False And Cells(21, "AB").Value = False Then

Dim ie As Object
Dim SubjectLine As String
Dim Distro As String
Dim Body As String

Dim GetIE As Object
For Each GetIE In CreateObject("Shell.Application").Windows() 'Loop to find
If (Not GetIE Is Nothing) And GetIE.Name = "Internet Explorer" Then Exit For 'Found!
Next GetIE
GetIE.Visible = True 'Make IE window visible
Set ie = GetIE

Dim HWNDSrc As Long
HWNDSrc = ie.HWND
SetForegroundWindow HWNDSrc

Dim sIEURL As String
sIEURL = ie.LocationURL

'Checks the URL so it can decide which set of code to run
If InStr(sIEURL, "mail.CompanyName.com") > 0 Then

'*********************************THIS SET IS FOR OLD VERSION OF WEBMAIL**********************************************

' Copies the distrobution list. IF you do not copy/paste it, it will not recognize different email addresses.
'These code change the distro line
Sheets("Setup").Range("F8").Copy
Sheets("Main Email Work Area").Select
SetForegroundWindow HWNDSrc

Set tags = ie.Document.GetElementsByTagName("input")
tags(0).Click
tags(0).Focus
Application.SendKeys ("^v"), True
Application.Wait Now + TimeValue("00:00:01")



'This code sets the subject line
Sheets("Main Email Work Area").Select
Range(Cells(7, "J"), Cells(7, "M")).Select
Selection.Copy

SetForegroundWindow HWNDSrc
Application.Wait Now + TimeValue("00:00:01")
tags(3).Click
tags(3).Focus
Application.SendKeys ("^v"), True
Application.Wait Now + TimeValue("00:00:01")




'This code sets the email body
Sheets("Main Email Work Area").Select
emailBodyCopy = 120
While Cells(emailBodyCopy, "J").Value = ""
       emailBodyCopy = emailBodyCopy - 1
Wend
Range(Cells(emailBodyCopy, "J"), Cells(13, "L")).Select
Selection.Copy

SetForegroundWindow HWNDSrc

Set bodyarea = ie.Document.GetElementsByClassName("allowTextSelection _mcp_32 customScrollBar ms-bg-color-white ms-font-color-black owa-font-compose")
bodyarea(0).Click
bodyarea(0).Focus
Application.SendKeys ("^v"), True
Application.Wait Now + TimeValue("00:00:01")


'Tries to click the attach button
Set attach = ie.Document.GetElementsByTagName("button")
For Each Button In attach
If Button.Title = "Attach" Then
Button.Click
Exit For
End If
Next

Set ie = Nothing

Else

'*********************************THIS SET IS FOR OFFICE365 VERSION OF WEBMAIL**********************************************
' Copies the distrobution list. IF you do not copy/paste it, it will not recognize different email addresses.
Sheets("Setup").Range("F8").Copy
Sheets("Main Email Work Area").Select

SetForegroundWindow HWNDSrc

'These code change the distro line
Set tags = ie.Document.GetElementsByTagName("Input")
tags(3).Click
tags(3).Focus
Application.SendKeys ("^v"), True
Application.Wait Now + TimeValue("00:00:01")


'This code sets the subject line
Sheets("Main Email Work Area").Select
Range(Cells(7, "J"), Cells(7, "M")).Select
Selection.Copy

SetForegroundWindow HWNDSrc

tags(5).Click
tags(5).Focus
Application.Wait (Now + 0.000005)
Application.SendKeys ("^v"), True
Application.Wait Now + TimeValue("00:00:01")


'This code sets the email body
Sheets("Main Email Work Area").Select
emailBodyCopy = 120
While Cells(emailBodyCopy, "J").Value = ""
       emailBodyCopy = emailBodyCopy - 1
Wend
Range(Cells(emailBodyCopy, "J"), Cells(13, "L")).Select
Selection.Copy

SetForegroundWindow HWNDSrc

Set Tag = ie.Document.GetElementsByClassName("_4utP_vaqQ3UQZH0GEBVQe B1QSRkzQCtvCtutReyNZ _17ghdPL1NLKYjRvmoJgpoK _2s9KmFMlfdGElivl0o-GZb")
Tag(0).Click
Tag(0).Focus
Application.SendKeys ("^v"), True


' This finds the attach button and clicks it
Set attach = ie.Document.GetElementsByTagName("button")
For Each Button In attach
If Button.Name = "Attach" Then
Button.Click
Exit For
End If
Next

'This finds the "Browse" button inside the attach dropdown and clicks it.
Set attach = ie.Document.GetElementsByTagName("button")
For Each Button In attach
If Button.Name = "Browse this computer" Then
Button.Click
Exit For
End If
Next


Set ie = Nothing

End If

'Ends the IF for the auto copy/paste
End If

Это часть гораздо большего макроса, который запускается. В настоящее время я использую Office365, поэтому он выполняет ту часть кода, которая предназначена только для Office 365, но я хотел поместить весь добавленный код, который вызывает эту проблему, на всякий случай. При добавлении этого раздела это вызывает проблему с блокировкой num, без этого раздела это не вызывает проблем, поэтому в этом должно быть что-то.

Спасибо!

1 Ответ

0 голосов
/ 27 января 2020

Я смог добавить

Sendkeys "{NUMLOCK}", True

В конец моего кода прямо перед последним End End, и, похоже, это решило проблему.

Благодаря помощи @timWilliams

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...