Excel - Importar datos y Excel + Macro

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;" & strURL

'clean previous connections

If numConnections > 0 Then

For i = 1 To numConnections

    ThisWorkbook.Connections(i).Delete

Next i

End If

'clean datasheet

Sheets(1).Select

Sheets(1).Cells.Clear

'control excel app

Application.ScreenUpdating = False

'get web query

With Sheets(1).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

Public Function GoogleTranslation(ByVal strSourceText As String, ByVal strTargetLang As String) As String

Dim strTranslation, strURL As String

Dim objXMLHTTP As Object

'vars

strSourceText = Replace$(strSourceText, Chr$(32), "%20")

strSourceText = Replace$(strSourceText, Chr$(160), "%20")

'customizing google url parameters

strURL = "http://translate.google.com/translate_a/t?client=t&text={S}&hl=" & strTargetLang & "&sl={F}&tl={T}&multires=1&pc=0&rom=1&sc=1"

strURL = Replace$(strURL, "{S}", strSourceText)

'execute XMLHTTP

Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")

Call objXMLHTTP.Open("get", strURL, False)

Call objXMLHTTP.Send

strTranslation = objXMLHTTP.ResponseText

'translation result

strTranslation = Replace$(Mid$(CStr(Split(strTranslation, ",")(0)), 4), Chr$(34), "")

GoogleTranslation = strTranslation

End Function