0
Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare PtrSafe Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String) As Long
Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare PtrSafe Function SendMessageByString Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare PtrSafe Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Declare PtrSafe Function SetFocus Lib "user32.dll" (ByVal hWnd As Long) As Integer
Sub AtualizarBaseCRM()
Dim ie As New InternetExplorerMedium
Dim objEvent
'COMANDO PARA DEIXAR O INTERNET EXPLORER VISIVEL
'ie.Visible = True
ie.navigate ("https://crm.cyrela.com.br")
'AGUARDA O CARREGAMENTO DA PAGINA
While ie.Busy Or ie.ReadyState <> 4
DoEvents
Wend
'CASO NÃO ESTEJA LOGADO, ENTRA COM O LOGIN E SENHA
On Error GoTo BuscaAvancada
ie.Document.getelementbyid("ContentPlaceHolder1_UsernameTextBox").Value = ThisWorkbook.Sheets("Apoio Importação").Cells(1, 2).Value
ie.Document.getelementbyid("ContentPlaceHolder1_PasswordTextBox").Value = ThisWorkbook.Sheets("Apoio Importação").Cells(2, 2).Value
ie.Document.getelementbyid("ContentPlaceHolder1_SubmitButton").Click
'AGUARDA O CARREGAMENTO DA PAGINA
While ie.Busy Or ie.ReadyState <> 4
DoEvents
Wend
BuscaAvancada:
Err.Clear
On Error GoTo 0
'NAVEGA PARA O LINK DE LOCALIZAÇÃO AVNÇADA
ie.navigate "https://crm.cyrela.com.br/main.aspx?extraqs=%3fDataProvider%3dMicrosoft.Crm.Application.Platform.Grid.GridDataProvi" _
& "derQueryBuilder%26EntityCode%3d2029%26QueryId%3d%257b8EF40D37-0868-440C-AF6B-CAC0C62E78E3%257d%26UIProvider%3dMicrosoft.Crm.Application.Controls.GridUIProvider%26ViewType%3d1039&pagetype=advancedfind"
'AGUARDA O CARREGAMENTO DA PAGINA
Application.Wait (Now + TimeValue("00:00:01"))
While ie.Busy Or ie.ReadyState <> 4
DoEvents
Wend
'SELECIONA A OPÇÃO DE RÉGUA DE REPASSE
On Error Resume Next
ºtentativas = 0
ie.Document.getelementbyid("contentIFrame0").contentDocument.getelementbyid("slctPrimaryEntity").Value = "pjo_reguarepasse"
Do Until Err.Number = 0
Application.Wait (Now + TimeValue("00:00:01"))
Err.Clear
ie.Document.getelementbyid("contentIFrame0").contentDocument.getelementbyid("slctPrimaryEntity").Value = "pjo_reguarepasse"
ºtentativas = ºtentativas + 1
If ºtentativas > 30 Then
MsgBox "falha no download, tente novamente!"
ie.Quit
Exit Sub
End If
Loop
On Error GoTo 0
'DISPARA O EVENDO DE ALTERAÇÃO DE VALOR NA COMBOBOX DO SITE
Set objEvent = ie.Document.getelementbyid("contentIFrame0").contentDocument.createEvent("HTMLEvents")
objEvent.initEvent "change", False, True
ie.Document.getelementbyid("contentIFrame0").contentDocument.getelementbyid("slctPrimaryEntity").dispatchEvent objEvent
While ie.Busy Or ie.ReadyState <> 4
DoEvents
Wend
'SELECIONA O RELATÓRIO ESPECIFICO
ie.Document.getelementbyid("contentIFrame0").contentDocument.getelementbyid("savedQuerySelector").Value = "{883F9401-02B9-E711-80C0-00505695E94A}"
'DISPARA O EVENTO DE ALTERAÇÃO DE VALOR NA COMBOBOX DE RELATÓRIOS
Set objEvent = ie.Document.getelementbyid("contentIFrame0").contentDocument.createEvent("HTMLEvents")
objEvent.initEvent "change", False, True
ie.Document.getelementbyid("contentIFrame0").contentDocument.getelementbyid("savedQuerySelector").dispatchEvent objEvent
'AGUARDA O CARREGAMENTO DA PAGINA
Application.Wait (Now + TimeValue("00:00:01"))
While ie.Busy Or ie.ReadyState <> 4
DoEvents
Wend
'CLICA NO BOTÃO PARA EXIBIÇÃO DO RESULTADO DA LOCALIZAÇÃO AVANÇADA
On Error Resume Next
ie.Document.getelementbyid("Mscrm.AdvancedFind.Groups.Show.Results-Large").Click
ºtentativas = 0
Do Until Err.Number = 0
Application.Wait (Now + TimeValue("00:00:01"))
Err.Clear
ie.Document.getelementbyid("Mscrm.AdvancedFind.Groups.Show.Results-Large").Click
ºtentativas = ºtentativas + 1
If ºtentativas > 30 Then
MsgBox "falha no download, tente novamente!"
ie.Quit
Exit Sub
End If
Loop
On Error GoTo 0
'AGUARDA O CARREGAMENTO DA PAGINA
Application.Wait (Now + TimeValue("00:00:01"))
While ie.Busy Or ie.ReadyState <> 4
DoEvents
Wend
'CLICA NA OPÇÃO DE EXPORTAÇÃO DO RELATÓRIO EM EXCEL NO CABEÇALHO DA PAGINA
On Error Resume Next
ie.Document.getelementbyid("pjo_reguarepasse|NoRelationship|SubGridStandard|Mscrm.SubGrid.pjo_reguarepasse.ExportToExcel-Large").Click
ºtentativas = 0
Do Until Err.Number = 0
Application.Wait (Now + TimeValue("00:00:01"))
Err.Clear
ie.Document.getelementbyid("pjo_reguarepasse|NoRelationship|SubGridStandard|Mscrm.SubGrid.pjo_reguarepasse.ExportToExcel-Large").Click
ºtentativas = ºtentativas + 1
If ºtentativas > 30 Then
MsgBox "falha no download, tente novamente!"
ie.Quit
Exit Sub
End If
Loop
On Error GoTo 0
'AGUARDA O CARREGAMENTO DA PAGINA
Application.Wait (Now + TimeValue("00:00:01"))
While ie.Busy Or ie.ReadyState <> 4
DoEvents
Wend
'COLOCA A OPÇÃO DE EXPORTAR EXCEL DE TODA EXTRAÇÃO E DA O OK PARA O DOWNLOAD
On Error Resume Next
ie.Document.getelementbyid("InlineDialog_Iframe").contentDocument.getelementbyid("printAll").Click
ºtentativas = 0
Do Until Err.Number = 0
Application.Wait (Now + TimeValue("00:00:01"))
Err.Clear
ie.Document.getelementbyid("InlineDialog_Iframe").contentDocument.getelementbyid("printAll").Click
ºtentativas = ºtentativas + 1
If ºtentativas > 30 Then
MsgBox "falha no download, tente novamente!"
ie.Quit
Exit Sub
End If
Loop
On Error GoTo 0
ie.Document.getelementbyid("InlineDialog_Iframe").contentDocument.getelementbyid("dialogOkButton").Click
'AGUARDA O CARREGAMENTO DA PAGINA
While ie.Busy Or ie.ReadyState <> 4
DoEvents
Wend
'CONTA O NUMERO DE ARQUIVOS NA PASTA ANTES DO DOWNLOAD INICIAR
ºArquivo = Dir("C:\Users\" & Environ("username") & "\Downloads\*.xls")
ºN_arquivos = 0
Do While ºArquivo <> ""
ºN_arquivos = ºN_arquivos + 1
ºArquivo = Dir
Loop
'FUNÇÃO PARA INICIAR O DOWNLOAD
Application.Wait (Now + TimeValue("00:01:00"))
hpass = ie.hWnd
ie.Visible = True
DownloadFile (hpass)
ie.Visible = False
'VERIFICA SE O DOWNLOAD ESTA CONCLUIDO COM BASE NO NUMERO DE ARQUIVOS NA PASTA
ºN_arquivos_2 = 0
Do Until ºN_arquivos_2 > ºN_arquivos
ºArquivo = Dir("C:\Users\" & Environ("username") & "\Downloads\*.xls")
ºN_arquivos_2 = 0
Do While ºArquivo <> ""
ºN_arquivos_2 = ºN_arquivos_2 + 1
ºArquivo = Dir
Loop
Application.Wait (Now + TimeValue("00:00:02"))
Loop
ºArquivo_Baixado = NewestFile("C:\Users\" & Environ("username") & "\Downloads\", "*.xls")
ºDestino_na_Rede = ThisWorkbook.Sheets("Apoio Importação").Cells(3, 2).Hyperlinks(1).Address
If Dir(ºDestino_na_Rede) <> "" Then
Kill ºDestino_na_Rede
End If
'COPIAR O ARQUIVO BAIXADO PARA O DESTINO
FileCopy ºArquivo_Baixado, ºDestino_na_Rede
'DELETA O ARQUIVO BAIXADO
Kill ºArquivo_Baixado
MsgBox "Download concluído!" & Chr(10) & " A importação sera iniciada"
ie.Quit
Call Importar
End Sub
Sub Importar()
Application.ScreenUpdating = False
CaminhoArquivo = ThisWorkbook.Sheets("Apoio Importação").Cells(3, 2).Hyperlinks(1).Address
Workbooks.Open CaminhoArquivo, False, True
ThisWorkbook.Sheets("base").UsedRange.ClearContents
Workbooks(Dir(CaminhoArquivo)).Sheets(1).UsedRange.Copy
ThisWorkbook.Sheets("base").Range("a1").PasteSpecial xlPasteAll
Application.CutCopyMode = False
Workbooks(Dir(CaminhoArquivo)).Close False
MsgBox "Importação concluída!"
Sheets("Chart2").Activate
Application.ScreenUpdating = True
End Sub
Sub DownloadFile(h As Long)
Dim o As IUIAutomation
Dim e As IUIAutomationElement
Dim iCnd As IUIAutomationCondition
Dim Button As IUIAutomationElement
Dim InvokePattern As IUIAutomationInvokePattern
Set o = New CUIAutomation
h = FindWindowEx(h, 0, "Frame Notification Bar", vbNullString)
If h = 0 Then Exit Sub
Set e = o.ElementFromHandle(ByVal h)
Set iCnd = o.CreatePropertyCondition(UIA_NamePropertyId, "Salvar")
Set Button = e.FindFirst(TreeScope_Subtree, iCnd)
Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
InvokePattern.Invoke
End Sub
Function NewestFile(Directory, FileSpec)
Dim FileName As String
Dim MostRecentFile As String
Dim MostRecentDate As Date
FileName = Dir(Directory & FileSpec)
If FileName <> "" Then
MostRecentFile = FileName
MostRecentDate = FileDateTime(Directory & FileName)
Do While FileName <> ""
If FileDateTime(Directory & FileName) > MostRecentDate Then
MostRecentFile = FileName
MostRecentDate = FileDateTime(Directory & FileName)
End If
FileName = Dir
Loop
End If
NewestFile = Directory & MostRecentFile
End Function
Welcome(a). Please do the [tour], then read How we should format questions and answers?. And a site that assists in indentation for better reading of the code. And enter the error code to help better understand the problem.
– danieltakeshi
Run-time error '91': Object variable or With Block variable not set Ai in Debug, the line with error: Set Invokepattern = Button.Getcurrentpattern(Uia_invokernid)
– Lucas Daros
Unfortunately I can not access your link, but it was possible to download with this test code
– danieltakeshi