Importar dados da Web


#1

Bom dia, criei um código com a ajuda do gravador de macros e realizei os ajustes necessários.
A idéia da macro é o usuário informar o CA (certificado de aprovação) de um EPI e ela verificar no site a validade deste.
Ocorre que conforme mudamos o número do CA o valor do campo validade muda de linha.
Em alguns momento ele está na célula A26 e em outros está na A22 por exemplo, impossibilitando o uso desta informação em outra planilha.

Teriam alguma sugestão?

Sub testeweb()
Dim ca As Integer
Cells.Select
Range(“C4”).Activate
Selection.ClearContents
Range(“A1”).Select
ca = Application.InputBox(“Digite o CA:”)
With ActiveSheet.QueryTables.Add(Connection:=“URL;https://consultaca.com/” & ca _
, Destination:=Range("$A$1"))
.Name = “445”
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingRTF
.WebPreFormattedTextToColumns = False
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Range(“A3”).Select
With Selection.QueryTable
.Name = “445”
.FieldNames = True
.RowNumbers = True
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertEntireRows
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
End With
End Sub


#2

Olá Claudio.

Pode me encaminhar a planilha com neste e-mail contato@hbs-sheets.com

Consigo te ajudar!