Popup Preventing Macro from Advancing

Asked

Viewed 99 times

1

I have a macro that enters a particular site, fills in a form, and sends a save for the system, generates a request. After that, a popup is issued with a button "OK". This ok has a eventClick that ends the process and restarts the cycle. Data is only saved if you click on the OK of the popup. But when it comes up, I can’t proceed with the macro unless I click manually.

Is there any way to autoconfirm this button?

    Option Base 1

Public Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function GetDlgItem Lib "User32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long
Public Declare Function GetDlgItemText Lib "User32" Alias "GetDlgItemTextA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long
Public Declare Function BringWindowToTop Lib "user32.dll" (ByVal hwnd As Long) As Long
Public Declare Function ShowWindow& Lib "User32" (ByVal hwnd As Long, ByVal nCmdShow As Long)
Public Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long


'Constants for topmost
Public Const HWND_TOPMOST = -1

Public Const HWND_NOTOPMOST = -2
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOACTIVATE = &H10
Public Const SWP_SHOWWINDOW = &H40
Public Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE

Public Declare Function SetWindowPos Lib "User32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)


Public IE
Public IE2
Dim Doc


Sub Aguarda()
    Do While IE.busy 'Fica em loop até que a página tenha sido carregada
        Sleep 50
        DoEvents
    Loop
    Do While (IE.readystate < 4)
        Sleep 50
        DoEvents
    Loop

End Sub

Sub Justifica()

    AtualizaDados
    LoopIeInstances

    Dim Linha As Long

    Linha = 6

    Do While Plan1.Range("A" & Linha).Value <> ""
        Relatorio "159"
        Relatorio "302"
        Relatorio 302 Plan1.Range("A" & Linha).Value, Plan1.Range("C" & Linha).Value
        Linha = Linha + 1
    Loop
End Sub

Sub LoopIeInstances()
Dim oShApp As Object, oWin As Object
Dim WScript As Object
Set oShApp = CreateObject("Shell.Application")

Set IE = Nothing
For Each oWin In oShApp.Windows
    If TypeName(oWin.Document) = "HTMLDocument" Then
        If (oWin.Document.domain = "Sistemavli.vlinet.local" Or oWin.Document.domain = "Sistemavli") And oWin.Document.nameprop <> "Painel Gráfico de Circulação de Trens" Then
            Set IE = oWin
            Application.StatusBar = "Utilizando o Sistema em: " & oWin.Document.domain
            Exit For
        End If
    End If
Next
If IE Is Nothing Then
    MsgBox "Nenhuma janela do Internet Explorer está logada no Sistema" & vbCrLf & "Por favor faça o Login no Sistema e tente outra vez.", vbCritical + vbOKOnly
    Application.Cursor = xlDefault
    End
Else
End If
'Set IE = CreateObject("InternetExplorer.Application")
'With IE
'Do While .busy: DoEvents: Loop
'Do While .readystate <> 4: DoEvents: Loop
'Call ShowWindow(.hwnd, 3)
'.Visible = True
'Set WScript = CreateObject("WScript.Shell")
'Set WScript = Nothing
'End With

End Sub
Sub Relatorio(Tela As String)
    LoopIeInstances
    Do While IE.busy 'Fica em loop até que a página tenha sido carregada
        DoEvents
    Loop
    Set Doc = IE.Document 'Obtém o documento

    Dim R As Long

    'If Doc.all.Item("Link").Value = Tela Then Exit Sub

    Doc.all.Item("Link").Focus
    Doc.all.Item("Link").innertext = Tela
    R = BringWindowToTop(IE.hwnd)

    SendKeys "{ENTER}" ' same as pressing tabs once


    Aguarda

End Sub

Sub Tela410(Linha As Long)
    Dim R As Long
    Dim Valida As Boolean
    Dim Cont As Long
    Dim Coluna As Long


    LoopIeInstances
    Relatorio "159"
    Aguarda
    Relatorio "410"
    Aguarda


    Dim Teste

    Set Doc = IE.Document 'Obtém o documento
    Set Doc = Doc.Frames("MAINFRAME").Document.all(0)

    Aguarda




    Set e = Doc.all.tags("div").Item(3)


    e.all.Item(0).Click
    Aguarda

    Set Doc = IE.Document 'Obtém o documento
    Set Doc = Doc.Frames("MAINFRAME").Document.all(1)
    Aguarda





    Doc.all.Item("PID_EMPRESA").Focus
    Doc.all.Item("PID_EMPRESA").Value = Plan1.Range("H" & Linha).Value
    SendKeys "{DOWN}"
    SendKeys "{UP}"

    Doc.all.Item("DATA_PEDIDO").Focus
    Doc.all.Item("DATA_PEDIDO").Value = Format(Plan1.Range("B" & Linha).Value, "dd/mm/yyyy")
    Doc.all.Item("CODIGO_ORIGEM").Value = Plan1.Range("C" & Linha).Value
    Doc.all.Item("CODIGO_DESTINO").Value = Plan1.Range("D" & Linha).Value
    Doc.all.Item("QTDE_CARREGADO").Value = Plan1.Range("E" & Linha).Value
    If Plan1.Range("F" & Linha_excel).Value <> "" Then Doc.all.Item("SERIE_produto").Value = Plan1.Range("F" & Linha_excel).Value
    If Plan1.Range("G" & Linha_excel).Value <> "" Then Doc.all.Item("FROTA_produto").Value = Plan1.Range("G" & Linha_excel).Value


 Set e = Doc.all.tags("img").Item(1)


    'R = BringWindowToTop(IE.hwnd)
    'SendKeys "{DOWN}"
    'SendKeys "{UP}"

e.Click


' e.OnClick


End Sub
  • Without Link or HTML code, it is a more difficult to replicate the error. A mcve can be created.

No answers

Browser other questions tagged

You are not signed in. Login or sign up in order to post.