Rafael Siqueira

Não consigo automatizar uma extração que é feita do SAP, quando eu finalizo a extração e vou fazer a tratativa na planilha da problema, a planilha que eu preciso abrir se localiza em um servidor e a planilha é pesada, quando vai abrir o arquivo ele fica com a mensagem de baixando e não termina até ser clicado em cancelar ou quando passa dessa etapa quando ele vai salvar a planilha no servidor ele fica com a mensagem de salvando e não finaliza até clicar em cancelar, clicando em cancelar ele abre ou salva o arquivo perfeitamente. Como eu faço para resolver esse problema com a macro, segue o código da macro para entendimento: Private Declare PtrSafe Function CoRegisterMessageFilter Lib "OLE32.DLL" (ByVal lFilterIn As Long, ByRef lPreviousFilter) As Long Sub OCUPACAO() Application.DisplayAlerts = False On Error GoTo TratamentoErro Dim SapGui As Object, Applic As Object, connection As Object, session As Object Dim WshShell As Object, lMsgFilter As Long Dim DIA As Integer, Mes As Integer, Ano As Integer Dim caminho As String, lastRow2 As Long, firstRow2 As Long Dim WshShell2 As Object Dim DesktopPath As String ' Cria um objeto WshShell Set WshShell2 = CreateObject("WScript.Shell") ' Obtém o caminho da área de trabalho DesktopPath = WshShell2.SpecialFolders("Desktop") ' Iniciar SAP Logon Set WshShell = CreateObject("WScript.Shell") Shell "C:\Program Files (x86)\SAP\FrontEnd\SAPgui\saplogon.exe", vbNormalFocus Do Until WshShell.AppActivate("SAP Logon ") Application.Wait Now + TimeValue("0:00:05") Loop Set WshShell = Nothing ' Conectar ao SAP Set SapGui = GetObject("SAPGUI") Set Applic = SapGui.GetScriptingEngine Set connection = Applic.OpenConnection("ERP 6.0 - PRODUÇÃO", True) Set session = connection.Children(0) ' Login no SAP With session .findById("wnd[0]").maximize .findById("wnd[0]/usr/txtRSYST-MANDT").Text = "300" .findById("wnd[0]/usr/txtRSYST-BNAME").Text = "rgomes05" .findById("wnd[0]/usr/pwdRSYST-BCODE").Text = "Control#24" .findById("wnd[0]/usr/txtRSYST-LANGU").Text = "PT" .findById("wnd[0]").sendVKey 0 .findById("wnd[0]").sendVKey 0 End With CoRegisterMessageFilter 0&, lMsgFilter ' Extração da ocupação caminho = "\\p7000\Unipac_Custos\Custos\Extração de Relatórios\Relatórios\OCUPACAO_UNIP.XLS" If Dir(caminho) <> "" Then Kill caminho Dim Inicio As String, Fim As String Inicio = Range("B110").Value Fim = Range("D110").Value With session .findById("wnd[0]").maximize .findById("wnd[0]/tbar[0]/okcd").Text = "ksb1" .findById("wnd[0]").sendVKey 0 .findById("wnd[0]/tbar[1]/btn[17]").press .findById("wnd[1]/usr/txtENAME-LOW").Text = "twada" .findById("wnd[1]/usr/txtENAME-LOW").SetFocus .findById("wnd[1]/usr/txtENAME-LOW").caretPosition = 5 .findById("wnd[1]/tbar[0]/btn[8]").press .findById("wnd[1]/usr/cntlALV_CONTAINER_1/shellcont/shell").currentCellRow = 7 .findById("wnd[1]/usr/cntlALV_CONTAINER_1/shellcont/shell").selectedRows = "7" .findById("wnd[1]/usr/cntlALV_CONTAINER_1/shellcont/shell").doubleClickCurrentCell .findById("wnd[0]/usr/ctxtR_BUDAT-LOW").Text = Inicio .findById("wnd[0]/usr/ctxtR_BUDAT-HIGH").Text = Fim .findById("wnd[0]/usr/ctxtP_DISVAR").Text = "/DESPESAS II" .findById("wnd[0]/usr/ctxtP_DISVAR").SetFocus .findById("wnd[0]/usr/ctxtP_DISVAR").caretPosition = 12 .findById("wnd[0]/tbar[1]/btn[8]").press .findById("wnd[0]/mbar/menu[0]/menu[3]/menu[2]").Select .findById("wnd[1]/usr/subSUBSCREEN_STEPLOOP:SAPLSPO5:0150/sub:SAPLSPO5:0150/radSPOPLI-SELFLAG[1,0]").Select .findById("wnd[1]/usr/subSUBSCREEN_STEPLOOP:SAPLSPO5:0150/sub:SAPLSPO5:0150/radSPOPLI-SELFLAG[1,0]").SetFocus .findById("wnd[1]/tbar[0]/btn[0]").press .findById("wnd[1]/usr/ctxtDY_PATH").Text = "\\p7000\Unipac_Custos\Custos\Extração de Relatórios\Relatórios" .findById("wnd[1]/usr/ctxtDY_FILENAME").Text = "OCUPACAO_UNIP.XLS" .findById("wnd[1]/usr/ctxtDY_FILENAME").caretPosition = 17 .findById("wnd[1]/tbar[0]/btn[0]").press .findById("wnd[0]/tbar[0]/btn[3]").press .findById("wnd[1]/usr/btnSPOP-OPTION1").press .findById("wnd[0]/tbar[0]/btn[3]").press .findById("wnd[0]").Close .findById("wnd[1]/usr/btnSPOP-OPTION1").press End With ' Processar arquivo Excel - Dados Ocupacao Workbooks.OpenText Filename:= _ "\\p7000\Unipac_Custos\Dados Ocupacao - 09.xlsx", _ Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _ xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _ Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _ Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _ Array(9, 1), Array(10, 1)), TrailingMinusNumbers:=True With Workbooks("Dados Ocupacao - 09.xlsx").Sheets("BASE REAL") lastRow2 = .Cells(.Rows.Count, 3).End(xlUp).Row firstRow2 = .Cells(lastRow2, 3).End(xlUp).Row .Range("C" & firstRow2 & ":G" & lastRow2).ClearContents End With Application.Wait Now + TimeValue("0:00:05") ' Processar arquivo Excel - OCUPACAO_UNIP Workbooks.OpenText Filename:= _ "\\p7000\Unipac_Custos\Custos\Extração de Relatórios\Relatórios\OCUPACAO_UNIP.XLS", _ Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _ xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _ Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _ Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _ Array(9, 1), Array(10, 1)), TrailingMinusNumbers:=True With Workbooks("OCUPACAO_UNIP.XLS").Sheets(1) .Columns("B").Delete .Cells.AutoFilter .Range("H1").AutoFilter Field:=8, Criteria1:="=MHOM - MINUTO HOMEM", Operator:=xlOr, Criteria2:="=MMAQ - MIN MÁQUINA" lastRow2 = .Cells(.Rows.Count, 2).End(xlUp).Row firstRow2 = .Cells(lastRow2, 2).End(xlUp).Row .Range("B" & firstRow2 & ":F" & lastRow2).Copy End With Application.Wait Now + TimeValue("0:00:05") ' Colar dados na planilha Dados Ocupacao Workbooks("Dados Ocupacao - 09.xlsx").Activate With Sheets("BASE REAL") lastRow2 = .Cells(.Rows.Count, 3).End(xlUp).Row .Range("C" & lastRow2 + 2).PasteSpecial End With Application.Wait Now + TimeValue("0:00:05") ' Limpar e copiar dados adicionais With Workbooks("Dados Ocupacao - 09.xlsx").Sheets("BASE REAL") lastRow2 = .Cells(.Rows.Count, 9).End(xlUp).Row firstRow2 = .Cells(lastRow2, 9).End(xlUp).Row .Range("I" & firstRow2 & ":W" & lastRow2).ClearContents End With Application.Wait Now + TimeValue("0:00:05") ' Copiar dados da planilha OCUPACAO_UNIP With Workbooks("OCUPACAO_UNIP.XLS").Sheets(1) lastRow2 = .Cells(.Rows.Count, 7).End(xlUp).Row firstRow2 = .Cells(lastRow2, 7).End(xlUp).Row .Range("G" & firstRow2 & ":V" & lastRow2).Copy End With ' Colar dados na planilha Dados Ocupacao Workbooks("Dados Ocupacao - 09.xlsx").Activate With Sheets("BASE REAL") lastRow2 = .Cells(.Rows.Count, 9).End(xlUp).Row .Range("I" & lastRow2 + 2).PasteSpecial End With Workbooks("Dados Ocupacao - 09.xlsx").Save Workbooks("Dados Ocupacao - 09.xlsx").Close Workbooks("OCUPACAO_UNIP.XLS").Save Workbooks("OCUPACAO_UNIP.XLS").Close Kill "\\p7000\Unipac_Custos\Custos\Extração de Relatórios\Relatórios\OCUPACAO_UNIP.XLS" CoRegisterMessageFilter lMsgFilter, lMsgFilter TratamentoErro: Application.DisplayAlerts = True Exit Sub End Sub