- 06 Out 2017 às 08:59
#27074
Bom dia a todos,
meu caso é o seguinte, tenho um código que uma parte eu gravei e outra eu peguei na internet, esse código faz login e baixa uma tabela específica em um determinado site, o que ocorre é que, quando eu fecho a planilha o código para de funcionar, e só volta a fazer a mesma coisa quando substituo a parte que gravei por uma outra gravação de macro. Alguém poderia me ajudar a achar esse erro e fazer com que a macro funcionasse outra vez sem ter que gravar outra?
desde já agradeço a todos.
Dim HTMLdoc As HTMLDocument
Dim oBrowser As InternetExplorer
Dim oHTML_Element As IHTMLElement
Dim sURL As String
Dim CommandButton1_Click() As Adjustments
Sub Login()
Call Application.OnTime(Now + TimeValue("00:20:00"), "Login") 'timer
On Error GoTo Err_Clear
sURL = "http://xxxxxxxxxxxxxx/"
Set oBrowser = New InternetExplorer
oBrowser.Silent = True
oBrowser.timeout = 60
oBrowser.Navigate sURL
oBrowser.Visible = True
Do
Loop Until oBrowser.ReadyState = READYSTATE_COMPLETE
Set HTMLdoc = oBrowser.document
HTMLdoc.all.user.Value = "xxxxxxx"
HTMLdoc.all.pw.Value = "xxxxxxx"
For Each oHTML_Element In HTMLdoc.getElementsByTagName("input")
If oHTML_Element.Type = "submit" Then oHTML_Element.Click: Exit For
Next
Err_Clear:
Resume Next
' parte da gravação da macro
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://xxxxxxxxxxxxxxxxxxx", Destination:=Range("$A$3") _
)
.CommandType = 0
.Name = "bugs"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "4"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery = True
End With
End Sub
meu caso é o seguinte, tenho um código que uma parte eu gravei e outra eu peguei na internet, esse código faz login e baixa uma tabela específica em um determinado site, o que ocorre é que, quando eu fecho a planilha o código para de funcionar, e só volta a fazer a mesma coisa quando substituo a parte que gravei por uma outra gravação de macro. Alguém poderia me ajudar a achar esse erro e fazer com que a macro funcionasse outra vez sem ter que gravar outra?
desde já agradeço a todos.
Dim HTMLdoc As HTMLDocument
Dim oBrowser As InternetExplorer
Dim oHTML_Element As IHTMLElement
Dim sURL As String
Dim CommandButton1_Click() As Adjustments
Sub Login()
Call Application.OnTime(Now + TimeValue("00:20:00"), "Login") 'timer
On Error GoTo Err_Clear
sURL = "http://xxxxxxxxxxxxxx/"
Set oBrowser = New InternetExplorer
oBrowser.Silent = True
oBrowser.timeout = 60
oBrowser.Navigate sURL
oBrowser.Visible = True
Do
Loop Until oBrowser.ReadyState = READYSTATE_COMPLETE
Set HTMLdoc = oBrowser.document
HTMLdoc.all.user.Value = "xxxxxxx"
HTMLdoc.all.pw.Value = "xxxxxxx"
For Each oHTML_Element In HTMLdoc.getElementsByTagName("input")
If oHTML_Element.Type = "submit" Then oHTML_Element.Click: Exit For
Next
Err_Clear:
Resume Next
' parte da gravação da macro
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://xxxxxxxxxxxxxxxxxxx", Destination:=Range("$A$3") _
)
.CommandType = 0
.Name = "bugs"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "4"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery = True
End With
End Sub
