Vídeo recomendado
https://youtu.be/diWPPPhW-9E

Internet Explorer 8 - VBA

Fórum para dúvidas sobre os fundamentos da linguagem de programação Visual Basic no contexto do VBA
marcostorres
Acabou de chegar
Acabou de chegar
Mensagens: 5
Registrado em: Qui Nov 01, 2012 3:52 pm

Internet Explorer 8 - VBA

Mensagem por marcostorres »

Boa tarde pessoal, tudo bem?

Estou criando um código VBA para baixar arquivos na web, usando o Internet Explorer 8 .

Estou encontrando dificuldade na hora de baixar os arquivos, quando minha aplicação clica no botão de baixar o arquivo, o Internet Explorer 8, me retorna essas duas janelas.

Primeira:
Aparece a janela Download de arquivo, perguntando se eu gostaria de abrir, salvar, ou cancelar o download.
Eu gostaria de uma instrução que aperte o botão salvar.


Quando eu clico em salvar, aparece a janela salvar como do windown.

Alguém pode me ajuda, me mostrar como eu posso interagir com essa janelas a partir do meu código VBA?

Desde já meu muito obrigado.


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Avatar do usuário
webmaster
Administrador
Mensagens: 3114
Registrado em: Sex Jul 24, 2009 2:44 pm
Contato:

Re: Internet Explorer 8 - VBA

Mensagem por webmaster »

Marcos,

Nesse caso, essa dica não resolve?

viewtopic.php?f=20&t=2322&p=10590#p10577

Abraços


marcostorres
Acabou de chegar
Acabou de chegar
Mensagens: 5
Registrado em: Qui Nov 01, 2012 3:52 pm

Re: Internet Explorer 8 - VBA

Mensagem por marcostorres »

Pior que não cara, aquela pergunta foi eu mesmo que fiz, só que estava usando o IE9.
Não consegui resolver no IE9, ai migrei para IE8, Que ao invés de aparacer a barra de notificação de download no próprio IE, aparece umas janelas iguais as do windows. Você conhece alguma forma de interagir com essas janelas que foi aberta em tempo de execução do código?

Desde já muito obrigado por sua atenção.


Avatar do usuário
webmaster
Administrador
Mensagens: 3114
Registrado em: Sex Jul 24, 2009 2:44 pm
Contato:

Re: Internet Explorer 8 - VBA

Mensagem por webmaster »

Marcos,

Tinha pesquisado na época, mas não consegui encontrar pois ao que parece, essas caixas foram feitas exatamente para forçar a interação com o usuário. Desviar disso seria "violar" o padrão de navegação. Não estou certo, mas o jeito mais correto de fazer a integração é tentar obter a URL final do arquivo, através de serviços que são disponibilizados, quando o são.

Abraços


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


marcostorres
Acabou de chegar
Acabou de chegar
Mensagens: 5
Registrado em: Qui Nov 01, 2012 3:52 pm

Re: Internet Explorer 8 - VBA

Mensagem por marcostorres »

É realmente, esta difícil de interagir com essa janelas, mas de qualquer forma muito obrigado por sua atenção. \o/\o/ Valew


elvisbc2
Acabou de chegar
Acabou de chegar
Mensagens: 7
Registrado em: Sex Nov 30, 2012 8:51 am

Re: Internet Explorer 8 - VBA

Mensagem por elvisbc2 »

Marcos!

Cara! Já tive muuuito esse problema e depois de alguns dias de sofrimento achei a solução, é o seguinte, você vai usar um shellwindows, ele vai usar uma dll do windows para encontrar o handle da janela, ou seja achar o fio da miada pra mexer com ela. Tenho o seguinte código que realmente me salvou.

Código: Selecionar todos

Option Explicit

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

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long

Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Private Declare Function GetWindowTextLength Lib "user32" Alias _
"GetWindowTextLengthA" (ByVal hwnd As Long) As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, _
lpRect As RECT) As Long

Private Declare Sub 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)

Private Declare Function SetCursorPos Lib "user32" _
(ByVal x As Integer, ByVal Y As Integer) As Long

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

Private Declare Sub mouse_event Lib "user32.dll" (ByVal dwFlags As Long, _
ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)

'~~> Constants for pressing left button of the mouse
Const MOUSEEVENTF_LEFTDOWN As Long = &H2
'~~> Constants for Releasing left button of the mouse
Const MOUSEEVENTF_LEFTUP As Long = &H4
Const WM_SETTEXT As Long = &HC
Const BM_CLICK = &HF5
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const SWP_NOACTIVATE = &H10
Const SWP_SHOWWINDOW = &H40

Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Dim Ret As Long, OpenRet As Long, FlDwndHwnd As Long
Dim ChildRet As Long
Dim strBuff As String, ButCap As String
Dim pos As RECT

'~~> Use this if you want to specify your own name in the Save As Window


Public Sub Salvadora(ByRef siac As String)

'Verificar se o export é proveniente do Gestão ou Siac
Dim FileSaveAsName As String
If siac = "verdadeiro" Then
   FileSaveAsName = "C:\Documents and Settings\BC624223\Desktop\consulta_processos_final_exportar.xls"
Else
   FileSaveAsName = "C:\Documents and Settings\BC624223\Desktop\Macro\Gestao.xls"
End If

Dim AltKey As String
AltKey = "%"

On Error GoTo Whoa
    Application.Wait Now + TimeValue("00:00:01")
'tempo = Now + TimeValue("00:00:05")
 '   Do While Ret = 0
Ret = FindWindow(vbNullString, "Download de Arquivos")

If Ret = 0 Then
Application.Wait Now + TimeValue("00:00:03")
Ret = FindWindow(vbNullString, "Download de Arquivos")
End If
 '   If tempo < Now Then
   '     Exit Do
  '  End If
  '  Loop
If Ret <> 0 Then
 '~~> Pegar a Linha dos Botões
ChildRet = FindWindowEx(Ret, ByVal 0&, "Button", vbNullString)
If ChildRet = 0 Then
Application.Wait Now + TimeValue("00:00:03")
ChildRet = FindWindowEx(Ret, ByVal 0&, "Button", vbNullString)
End If
'    If tempo < Now Then
'        Exit Do
 '   End If
 '   Loop

    'Application.Wait Now + TimeValue("00:00:01")

If ChildRet = 0 Then
MsgBox "Janela Filha não Encontrada"
Exit Sub
End If

 '~~> Pegar o Caption da Janela Filha
strBuff = String(GetWindowTextLength(ChildRet) + 1, Chr$(0))
GetWindowText ChildRet, strBuff, Len(strBuff)
ButCap = strBuff

 '~~> Loop por todas as Janelas
Do While ChildRet <> 0
 '~~> Checar o nome da Palavra pra identificar se tem o Salvar
If InStr(1, ButCap, "Salvar") Then
 '~~> Se achar então sai do loop
OpenRet = ChildRet
Exit Do
End If

 '~~> Pegar a linha da próxima subjanela
ChildRet = FindWindowEx(Ret, ChildRet, "Button", vbNullString)
 '~~> Pegar o Caption
strBuff = String(GetWindowTextLength(ChildRet) + 1, Chr$(0))
GetWindowText ChildRet, strBuff, Len(strBuff)
ButCap = strBuff
Loop

 '~~> Checa se encontrou ou não
If OpenRet = 0 Then
MsgBox "A linha do Botão 'Salvar' não foi encontrada"
Exit Sub
End If

 '~~> Encontra as dimensões da Janela de Download
 '~~> Especifica a Janela e as Dimensões da tela

GetWindowRect OpenRet, pos

 '~~> Move o Cursor para o local na tela desejado
'SetCursorPos (pos.Left - 10), (pos.Top - 10)
 '~~> Suspends the execution of the current thread for a specified interval.
 '~~> This give ample amount time for the API to position the cursor
'Sleep 100
'SetCursorPos pos.Left, pos.Top
'Sleep 100
'SetCursorPos (pos.Left + pos.Right) / 2, (pos.Top + pos.Bottom) / 2

 '~~> Set the size, position, and Z order of "File Download" Window
'SetWindowPos Ret, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
'SetWindowPos Ret, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE

Sleep 500
SendKeys ("!s")
 '~~> Simula o movimento do Mouse e o Click do Botão esquerdo
 'SendKeys "{LEFT}"
  'Sleep 500
 'SendKeys "{ENTER}"
 'Sleep 500
'Call SendMessage(hwnd, BM_CLICK, False, ByVal Message)
'mouse_event MOUSEEVENTF_LEFTDOWN, (pos.Left + pos.Right) / 2, (pos.Top + pos.Bottom) / 2, 0, 0
'Sleep 700
'mouse_event MOUSEEVENTF_LEFTUP, (pos.Left + pos.Right) / 2, (pos.Top + pos.Bottom) / 2, 0, 0
'mouse_event MOUSEEVENTF_LEFTDOWN, (pos.Left + pos.Right) / 2, (pos.Top + pos.Bottom) / 2, 0, 0
'Sleep 700
'mouse_event MOUSEEVENTF_LEFTUP, (pos.Left + pos.Right) / 2, (pos.Top + pos.Bottom) / 2, 0, 0
'SendKeys "{ENTER}"
'Wait 10

 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 ' START OF SAVEAS ROUTINE '
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'    Application.Wait Now + TimeValue("00:00:02")

Ret = FindWindow(vbNullString, "Salvar como")

If Ret = 0 Then
Application.Wait Now + TimeValue("00:00:02")
Ret = FindWindow(vbNullString, "Salvar como")
End If


If Ret = 0 Then
MsgBox "Save As Window Not Found"
Exit Sub
End If

 ' '~~> Get the handle of the Main ComboBox
  ChildRet = FindWindowEx(Ret, ByVal 0&, "ComboBoxEx32", "")
 
  If ChildRet = 0 Then
  MsgBox "ComboBoxEx32 Window Not Found"
  Exit Sub
  End If

 '~~> Get the handle of the Main ComboBox
ChildRet = FindWindowEx(ChildRet, ByVal 0&, "ComboBox", "")


If ChildRet = 0 Then
MsgBox "ComboBox Window Not Found"
Exit Sub
End If

 '~~> Get the handle of the Edit
ChildRet = FindWindowEx(ChildRet, ByVal 0&, "Edit", "")

If ChildRet = 0 Then
MsgBox "Edit Window Not Found"
Exit Sub
End If

 '~~> COMMENT the below 3 lines if you do not want to specify a filename
'Wait 10
SendMess FileSaveAsName, ChildRet
'Wait 10

 '~~> Get the handle of the Save Button in the Save As Dialog Box
ChildRet = FindWindowEx(Ret, ByVal 0&, "Button", vbNullString)
If ChildRet = 0 Then
Application.Wait Now + TimeValue("00:00:01") 'alteração no tempo
ChildRet = FindWindowEx(Ret, ByVal 0&, "Button", vbNullString)
End If

 '~~> Check if we found it or not
If ChildRet = 0 Then
MsgBox "Save Button in Save As Window Not Found"
Exit Sub
End If

 '~~> Get the caption of the child window
strBuff = String(GetWindowTextLength(ChildRet) + 1, Chr$(0))
GetWindowText ChildRet, strBuff, Len(strBuff)
ButCap = strBuff

 '~~> Loop through all child windows
Do While ChildRet <> 0
'Workbooks.Application.ScreenUpdating = False

 '~~> Check if the caption has the word "Save"
If InStr(1, ButCap, "Sa&lvar") Then
 '~~> If this is the button we are looking for then exit
OpenRet = ChildRet
Exit Do
End If

 '~~> Get the handle of the next child window
ChildRet = FindWindowEx(Ret, ChildRet, "Button", vbNullString)
 '~~> Get the caption of the child window
strBuff = String(GetWindowTextLength(ChildRet) + 1, Chr$(0))
GetWindowText ChildRet, strBuff, Len(strBuff)
ButCap = strBuff
Loop

 '~~> Check if we found it or not
If OpenRet = 0 Then
MsgBox "The Handle of Save Button in Save As Window was not found"
Exit Sub
End If

 '~~> Save the file
 On Error Resume Next
 Kill FileSaveAsName

Sleep 700
SendMessage OpenRet, BM_CLICK, 0, ByVal 0&
Else
MsgBox "File Download Window Not found"
End If
'Workbooks.Application.ScreenUpdating = True
Do While ChildRet <> 0
ChildRet = FindWindowEx(Ret, ByVal 0&, "Button", vbNullString)
Loop
Exit Sub
Whoa:
MsgBox Err.Description
End Sub

Sub Wait(nSec As Double)
nSec = nSec + Timer
While nSec > Timer
DoEvents
Wend
End Sub

Sub SendMess(Message As String, hwnd As Long)
Call SendMessage(hwnd, WM_SETTEXT, False, ByVal Message)
End Sub


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Responder