After activating another window, macro stops running when it is required to AppActivate "Excel", True until excel window manually clicked and then it

[leighhobson89]

I have been sweating this for days mow and I have had enough. If I use this easy sample code to switch windows, the code works no problem:

Private Sub CommandButton1_Click()

AppActivate ("Untitled - Notepad"), True

Wait (3) 'a custom function that delays - works fine so i can see whats going on

AppActivate ("Book1 -Excel")

End Sub

This is an example showing the function working fine. However when I run my macro, it has quite a bit of code and also calls a function that I am still building but has been tweaked to run end to end as it is for testing purposes.

The problem is that at the point highlighted, when the macro is supposed to activate the Excel app to continue processing, it seems to indefinitely pause until i manually click the excel window (focus being in the browser at this point), it then continues processing to the end with no issues. The same is true if i try to switch to any other window from there instead of the Excel window.

I stress that I don't need it to activate Excel to run the next commands (I don't think)- this is just my attempt at a workaround to simulate me clicking the window so it continues. This doesn't seem right though, and plus it doesn't work anyway.

All I want solving is for the macro to continue past the point highlighted without requiring a click on the excel window. What am I doing wrong? Here is the main sub (followed by the function it calls.) (Remember this is being built still so a lot of codelines are commented out and incomplete, but I'm sure I havent missed anything, as there are no errors when running it, other than this issue, although obviously things could be improved a lot once i get it working!)

'Sub Main_Sequence(numberSongsValue, sufficesValue, optionEncoding)
'Main macro procedure

Sub Main_Sequence()

Dim searchValue As String
Dim cllipBoard As DataObject
Dim urlToCheck As String
Dim searchResultsIncorrect As Boolean
Dim StringTypeToCheck As Integer
Dim stringToCheck As String
Dim existStringOneOne As Integer
Dim existStringOneTwo As Integer
Dim existStringOneThree As Integer
Dim existStringTwoOne As Integer
Dim resultCheck As Integer

searchValue = Selection.Value

If searchValue = "" Then
        MsgBox ("You need at least one Search Term!")
        Stop
End If

'For i = 1 To numberSongsValue
    
    'temporary variable for testing suffices - remove BOTH lines
    Dim suffixValue As String
    suffixValue = "music"
       
    'Set add any suffixes on to the end of the search string and do search
    searchValue = searchValue + " " + suffixValue
    Selection.Value = searchValue
    Selection.Copy
    AppActivate ("Youtube - Mozilla Firefox")
    Wait (1)
    Application.SendKeys "^v~", True
    
    Wait (3)
    
    Application.SendKeys "%d", True
    'Filter by video
    Application.SendKeys "{RIGHT}", True
    Application.SendKeys FILTER_BY_VIDEO, True
    Application.SendKeys "~", True
    Wait (3)
    Application.SendKeys "%d", True
    Application.SendKeys "^c", True [COLOR=#ff0000]######BREAKS HERE ########[/COLOR]
    
    DoEvents
    AppActivate ("Chart_Downloader - Excel"), True

    Set cllipBoard = New DataObject
    cllipBoard.GetFromClipboard
    urlToCheck = cllipBoard.GetText
    
    'Start of functionality to filter search properly so no Playlists or Channels appear in list
    searchResultsIncorrect = True
    
    resultCheck = 0
    
    'stringTypeToCheck
    '1 = "Did you mean"
    '2 = "Showing results for"
               
    'Add one "tab" if this phrase appears
    StringTypeToCheck = 1
    stringToCheck = SPANISH_DID_YOU_MEAN
    Call FindUnwantedStringsToCheck(resultCheck, urlToCheck, StringTypeToCheck, stringToCheck)
    If resultCheck = 1 Then
    searchResultsIncorrectOne = False
    End If
    stringToCheck = ENGLISH_DID_YOU_MEAN
    Call FindUnwantedStringsToCheck(resultCheck, urlToCheck, StringTypeToCheck, stringToCheck)
    If resultCheck = 1 Then
        searchResultsIncorrectOne = False
    End If
    If resultCheck = 0 Then
        searchResultsIncorrectOne = False
    End If
    
    'Final check in-case network speeds stopped tabs being added by function
    If searchResultsIncorrectOne <> False Then
        MsgBox "Something went wrong while sorting out the video lists, please run the macro again, sorry!"
        Stop
    End If
    
    'Insert two "tabs" if this phrase appears
    StringTypeToCheck = 2
    stringToCheck = SPANISH_SHOWING_RESULTS_FOR
    Call FindUnwantedStringsToCheck(resultCheck, urlToCheck, StringTypeToCheck, stringToCheck)
    If resultCheck = 2 Then
      searchResultsIncorrectTwo = False
    End If
    stringToCheck = ENGLISH_SHOWING_RESULTS_FOR
    Call FindUnwantedStringsToCheck(resultCheck, urlToCheck, StringTypeToCheck, stringToCheck)
    If resultCheck = 2 Then
        searchResultsIncorrectTwo = False
    End If
    If resultCheck = 0 Then
        searchResultsIncorrectTwo = False
    End If
    
    'Final check in-case network speeds stopped tabs being added by function
    If searchResultsIncorrectTwo <> False Then
        MsgBox "Something went wrong while sorting out the video lists, please run the macro again, sorry!"
        Stop
    End If
    
    'Activate Browser again
    appActivateString = searchValue + " - Youtube"
    AppActivate (appActivateString), True
    
    ' Select first video and submit selection to load video
    If resultCheck = 1 Then
        Application.SendKeys "{Tab}", True
    ElseIf resultCheck = 2 Then
        Application.SendKeys "{Tab 2}", True
    End If
    
    Application.SendKeys "{Tab 15}~", True
    
    Wait (5)
    
' i = i + 1
    'press down on keyboard to select next entry
    'Next i

End Sub

And the function that runs (perfectly) in this code is:

[/CODE]Function FindUnwantedStringsToCheck(resultCheck, urlToCheck, StringTypeToCheck As Integer, stringToCheck As String)

Dim req As New WinHttpRequest
Dim rT As String, HasData As Boolean
Dim Doc As New HTMLDocument
Dim textHtml As String
Dim existString As Integer

req.Open "GET", urlToCheck
req.Send
DoEvents

rT = req.ResponseText
existString = 0

Set Doc = New HTMLDocument
Doc.Clear
CallByName Doc, "Write", VbMethod, rT
DoEvents

textHtml = Doc.Body.innerText

If StringTypeToCheck = 1 Then
existString = InStr(1, textHtml, stringToCheck, vbTextCompare)
If existString > 0 Then
resultCheck = 1
Set Doc = Nothing
Exit Function
End If
ElseIf StringTypeToCheck = 2 Then
existString = InStr(1, textHtml, stringToCheck, vbTextCompare)
If existString > 0 Then
resultCheck = 2
Set Doc = Nothing
Exit Function
End If

End If

Set Doc = Nothing

End Function

[/CODE]

Thanks in advance, I would be eternally greatful

 

[leighhobson89]

Sorry I should mention I'm running Windows 10 Pro and Excel 2016, and here is the function code in CORRECT tags!

Function FindUnwantedStringsToCheck(resultCheck, urlToCheck, StringTypeToCheck As Integer, stringToCheck As String)

Dim req As New WinHttpRequest
Dim rT As String, HasData As Boolean
Dim Doc As New HTMLDocument
Dim textHtml As String
Dim existString As Integer
    
req.Open "GET", urlToCheck
req.Send
DoEvents

rT = req.ResponseText
existString = 0

Set Doc = New HTMLDocument
Doc.Clear
CallByName Doc, "Write", VbMethod, rT
DoEvents

textHtml = Doc.Body.innerText
    
If StringTypeToCheck = 1 Then
    existString = InStr(1, textHtml, stringToCheck, vbTextCompare)
    If existString > 0 Then
        resultCheck = 1
        Set Doc = Nothing
        Exit Function
    End If
ElseIf StringTypeToCheck = 2 Then
    existString = InStr(1, textHtml, stringToCheck, vbTextCompare)
    If existString > 0 Then
        resultCheck = 2
        Set Doc = Nothing
        Exit Function
    End If
    
End If

Set Doc = Nothing

End Function

 

[John_w]

You could try SetForegroundWindow - see http://www.mrexcel.com/forum/excel-...t-after-having-ie-navigation.html#post3593908.

Or better, AttachThreadInput combined with other Windows API functions - http://www.mrexcel.com/forum/excel-...t-after-having-ie-navigation.html#post3594752

 

[leighhobson89]

Thanks - After checking the second link you gave me, I need help on updating the Declare functions I these are for 32 bit systems, and I am running Win 10 64 bit. If someone can tell me what to do here I will try this solution for my problem.

 

[John_w]

Before I attempt to update the API declarations for 64-bit, try another suggestion in that thread:

AppActivate Application.Caption

 

[leighhobson89]

Thanks, that works a treat and the macro automatiacally continues to the end now. A little bit ugly flipping between the browser and excel, just to go back to the browser again without anything seeming to happen (from a user perspective) Any reason why this is necessary to stop the macro pausing? It seems very strange. Anyway thanks a lot for the tip, at least I have it running now

I should have used IE - it has a lot of built in functionality to communicate with Excel through VBA, but I went down the Firefox route, so I'm sticking to it now, although theres still a lot of work to do until the whole thing is finished!

 

[John_w]

Replace the Windows API declarations with:

#If VBA7 Then

    Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" _
        (ByVal hwnd As LongPtr, _
        lpdwProcessId As LongPtr) As Long
     
    Private Declare PtrSafe Function AttachThreadInput Lib "user32" _
        (ByVal idAttach As Long, _
        ByVal idAttachTo As Long, _
        ByVal fAttach As Long) As Long  'all Long because thread IDs are still 32 bits wide in 64-bit Windows
     
    Private Declare PtrSafe Function GetForegroundWindow Lib "user32" _
        () As LongPtr
     
    Private Declare PtrSafe Function SetForegroundWindow Lib "user32" _
        (ByVal hwnd As LongPtr) As LongPtr
     
    Private Declare PtrSafe Function IsIconic Lib "user32" _
        (ByVal hwnd As LongPtr) As Long
     
    Private Declare PtrSafe Function ShowWindow Lib "user32" _
        (ByVal hwnd As LongPtr, _
        ByVal nCmdShow As Long) As Long
        
#Else

    Private Declare Function GetWindowThreadProcessId Lib "user32" _
        (ByVal hwnd As Long, _
        lpdwProcessId As Long) As Long
     
    Private Declare Function AttachThreadInput Lib "user32" _
        (ByVal idAttach As Long, _
        ByVal idAttachTo As Long, _
        ByVal fAttach As Long) As Long
     
    Private Declare Function GetForegroundWindow Lib "user32" _
        () As Long
     
    Private Declare Function SetForegroundWindow Lib "user32" _
        (ByVal hwnd As Long) As Long
     
    Private Declare Function IsIconic Lib "user32" _
        (ByVal hwnd As Long) As Long
     
    Private Declare Function ShowWindow Lib "user32" _
        (ByVal hwnd As Long, _
        ByVal nCmdShow As Long) As Long
        
#End If

 

[leighhobson89]

Thanks very much John. This issue is resolved now, that's great!