Clarion - CREAR UNA CONSULTA DE TC SUNAT PARTIENDO DE VBA A CLARION

Rem Attribute VBA_ModuleType=VBAModule

Option VBASupport 1

Sub O1Ol01OO1O1()

Dim O1Ol11OO1O1 As String

Dim O1OO11OO1O1 As InternetExplorer

Dim O1lO11OO1O1 As HTMLDocument

Dim O1lO11Ol1O1 As IHTMLElementCollection

Dim O1lO01Ol1O1 As HTMLTableCell

Dim O1lO01O11O1 As Long

Dim O1lO01O11O0, OllO01O11O0 As String

Dim OllO01l11O0 As Integer

Dim Olll01l11O0 As Date

Dim Olll01l11OO As Date

Range("b17:d100").ClearContents

O1lO01O11O0 = Format(Hoja1.Range("mes").Value, "00")

OllO01O11O0 = Hoja1.Range("anio").Value

fechadeclara = DateSerial(OllO01O11O0, O1lO01O11O0 + 1, 0)

Olll01l11O0 = DateSerial(Year(Date), Month(Date) + 1, 0)

'Debug.Print fechadeclara & " y: " & Olll01l11O0

If fechadeclara > Olll01l11O0 Then

MsgBox "El periodo de consulta supera al periodo actual.", vbCritical, "Error en el Periodo"

Exit Sub

End If

Application.StatusBar = "Obteniendo Tipo de Cambio desde la Web de SUNAT"

Application.EnableEvents = False

Application.ScreenUpdating = False

O1Ol11OO1O1 = "http://www.sunat.gob.pe/cl-at-ittipcam/tcS01Alias?mesElegido=01&anioElegido=2018&mes=" & O1lO01O11O0 & "&anho=" & OllO01O11O0 & "&accion=init&email="

Set O1OO11OO1O1 = New InternetExplorer

With O1OO11OO1O1

.Navigate O1Ol11OO1O1

.Visible = False

While .Busy Or .ReadyState <> READYSTATE_COMPLETE: DoEvents: Wend

Set O1lO11OO1O1 = .Document

End With

Set O1lO11Ol1O1 = O1lO11OO1O1.getElementsByTagName("Td")

For Each O1lO01Ol1O1 In O1lO11Ol1O1

Select Case O1lO01Ol1O1.className

Case "H3"

Range("b65536").End(xlUp).Offset(1, 0).Value = DateSerial(OllO01O11O0, O1lO01O11O0, O1lO01Ol1O1.innerText)

Case "tne10"

If O1lO01Ol1O1.innerText = "" Then O1lO01Ol1O1.innerText = "SIN T.C"

If Range("b65536").End(xlUp).Offset(0, 1).Value = "" Then

Range("c65536").End(xlUp).Offset(1, 0).Value = O1lO01Ol1O1.innerText

Else

Range("c65536").End(xlUp).Offset(0, 1).Value = O1lO01Ol1O1.innerText

End If

End Select

Next

Application.StatusBar = "Listo!!! se obtuvo el tipo de cambio"

O1OO11OO1O1.Quit

Call Olll00l11OO

Application.EnableEvents = True

Application.ScreenUpdating = True

End Sub

Sub Olll00l11OO()

Dim Olll00l1lOO As Date

Dim Olll00l1lO0 As Integer

Dim O1ll00l1lO0 As Integer

z = Range("b65536").End(xlUp).Value

Cells(17, "b").Select

Olll00l1lOO = Cells(17, "b").Value

Olll00l1lO0 = Year(Olll00l1lOO)

O1ll00l1lO0 = Month(Olll00l1lOO)

Do

regresa:

If ActiveCell.Value = "" Or Day(ActiveCell.Value) <> ActiveCell.Row - 16 Then

Range(Cells(ActiveCell.Row, "b"), Cells(ActiveCell.Row, "d")).Insert shift:=xlDown, copyorigin:=xlFormatFromRightOrBelow

ActiveCell.Value = DateSerial(Olll00l1lO0, O1ll00l1lO0, ActiveCell.Row - 16)

ActiveCell.Offset(0, 1).Value = Val(ActiveCell.Offset(-1, 1).Value)

ActiveCell.Offset(0, 2).Value = Val(ActiveCell.Offset(-1, 2).Value)

GoTo regresa

End If

If Range("b" & ActiveCell.Row).Value = z Then Exit Sub

ActiveCell.Offset(1, 0).Select

Loop Until ActiveCell.Row = Day(DateSerial(Olll00l1lO0, O1ll00l1lO0 + 1, 0)) + 17

Range("C17:D48").NumberFormat = "_ * #,##0.000_ ;_ * -#,##0.000_ ;_ * ""-""??_ ;_ @_ "

Range("b5").Select

End Sub

data

WebBrowser                      LONG,AUTO

O1Ol11OO1O1                 string(250)

code

O1Ol11OO1O1="http://www.sunat.gob.pe/cl-at-ittipcam/tcS01Alias?mesElegido=01&anioElegido=2018&mes=" & O1lO01O11O0 & "&anho=" & OllO01O11O0 & "&accion=init&email="

WebBrowser              = CREATE(0,CREATE:OLE)

WebBrowser{PROP:Create} = 'InternetExplorer.Application'

WebBrowser{'Navigate(' & O1Ol11OO1O1 & ')'}

O1lO11Ol1O1=WebBrowser{'getElementsByTagName("Td")'}

etc..ect...