Export date to excel vba from a web page

Question

Export date to excel vba from a web page

Navigation

#1 by (0 votes)
#2 by (0 votes)

0

I am trying to export from a web page ( link ) the data of the table 1 Colombian Peso Rates table . The problem is that I do not export the date. Someone can help me with that.Annex image of the table to export table and image after exporting the table to excel.

Thank you.

The code I am using is the following:

Sub Actualizar_datos()
'Ejecutamos a la macro Elimina_Datos para eliminar la conexión, la querytable y los datos
Call Elimina_Datos
'Creamos nueva conexión con la web que contiene la tabla o datos que necesitamos

 With Sheets("CONVERSION").QueryTables.Add(Connection:=
"URL;https://xe.com/currencytables/?from=COP&date=2018-05-09", Destination:=Range("$A$1"))
'indicamos el nombre de la querytable, debemos acabarla con _1 de lo contrario, el sistema otorgará un valor numérico
    .Name = "Colombian Peso Rates table"
    'ajustamos las columnas
    .AdjustColumnWidth = True
    'actualizamos los datos cada minuto
    .RefreshPeriod = 60
    'descargamos los datos de la tabla 1
    .WebTable = "1"
    'actualizamos datos en segundo plano
    .Refresh BackgroundQuery:=False
 End With
 End Sub

Sub Elimina_Datos()
Application.ScreenUpdating = False
Dim cnn As Object
'eliminamos la conexión que hemos creado
For Each cnn In ThisWorkbook.Connections
If ActiveWorkbook.Connections.Count > 0 Then cnn.Delete
Next cnn
With Sheets("CONVERSION")
filas = Application.CountA(.Range("A:A"))
columnas = Application.CountA(.Range("1:1"))
'eliminamos todos los contenidos de la tabla
'Eliminamos la tabla
If filas And columnas > 0 Then
.Range(Cells(1, 1), Cells(filas, columnas)).Select
Selection.ClearContents
Selection.QueryTable.Delete
.Range("A1").Select
End If
End With
Application.ScreenUpdating = True
End Sub

vba vb.net asp.net visual-studio excel

asked by Jhon Martinez 09.05.2018 в 21:05

source

2 answers

Problems when doing push with Git Send data from a wordpress post to an external php

score 0 · Answer 1

I managed to export the date. This is the code.

 Sub WebDataImport()
 On Error GoTo ControlErr

Dim strURL As String
Dim strDestino As String, strReportName As String
Dim numConnections As Integer, i As Integer

'vars
numConnections = ThisWorkbook.Connections.Count
strDestino = "A1"
strReportName = "Reporte Mensual"
'strURL = InputBox("Indique URL origen", "Mensaje")

'check url data
If strURL <> Empty Then

'custom url address
strURL = "URL;https://xe.com/currencytables/?from=COP&" & strURL

'clean previous connections
If numConnections > 0 Then
For i = 1 To numConnections
ThisWorkbook.Connections(i).Delete
Next i
End If

'clean datasheet
Sheets(7).Select
Sheets(7).Cells.Clear

'control excel app
Application.ScreenUpdating = False
'get web query
With Sheets(7).QueryTables.Add(Connection:=strURL _
, Destination:=Range(strDestino))
.Name = strReportName
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

'control excel app
Application.ScreenUpdating = True

'final message
MsgBox "La importación ha finalizado", vbInformation, "Mensaje"

End If

Exit Sub

ControlErr:

MsgBox "Error: " & ERR.Description, vbCritical, "Mensaje"

End Sub

score 0 · Answer 2

Make application xhr. You do not need a web browser

Option Explicit
Public Sub GetTable()
    Dim sResponse As String, hTable As Object

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.x-rates.com/table/?from=COP&amount=1", False
        .send
        sResponse = StrConv(.responseBody, vbUnicode)
    End With

    sResponse = Mid$(sResponse, InStr(1, sResponse, "<!DOCTYPE "))

    With CreateObject("htmlFile")
        .Write sResponse
        Set hTable = .getElementsByTagName("table")(0)
    End With

    Worksheets.Add
    ActiveSheet.Name = "x-rates"
    WriteTable hTable

End Sub

Public Sub WriteTable(ByVal hTable As Object, Optional ByVal startRow As Long = 1, Optional ByVal ws As Worksheet)

    If ws Is Nothing Then Set ws = ActiveSheet

    Dim tSection As Object, tRow As Object, tCell As Object, tr As Object, td As Object, R As Long, C As Long, tBody As Object
    R = startRow
    With ActiveSheet
        Dim headers As Object, header As Object, columnCounter As Long
        Set headers = hTable.getElementsByTagName("th")
        For Each header In headers
            columnCounter = columnCounter + 1
            .Cells(startRow, columnCounter) = header.innerText
        Next header
        startRow = startRow + 1
        Set tBody = hTable.getElementsByTagName("tbody")
        For Each tSection In tBody               'HTMLTableSection
            Set tRow = tSection.getElementsByTagName("tr") 'HTMLTableRow
            For Each tr In tRow
                R = R + 1
                Set tCell = tr.getElementsByTagName("td")
                C = 1
                For Each td In tCell             'DispHTMLElementCollection
                    .Cells(R, C).Value = td.innerText 'HTMLTableCell
                    C = C + 1
                Next td
            Next tr
        Next tSection
    End With
End Sub

Excel:

Website: