Foros del Web - Ver Mensaje Individual

Mirador · #3 (**permalink**) 13/08/2008, 05:49

Finalmente use este codigo.

Saludos!

Código:

Private Sub sDownloadPDFs(ByVal strURL As String, ByVal strName As String)
    Dim blnError As Boolean
    On Error GoTo Error:
Inicio:
    Dim xmlHTTP: Set xmlHTTP = CreateObject("Microsoft.XMLHTTP")
    Dim sHTMLPage As String
    Const bGetAsAsync = False  ' para esperar respuesta

   ' Hace la llamada a la web
   xmlHTTP.Open "GET", strURL, bGetAsAsync
   xmlHTTP.Send  ' send it (to the web, wait for result)

   sHTMLPage = xmlHTTP.responseText  ' (como TEXT)
   If InStr(sHTMLPage, "<html>") Then
        msgbox("No hay PDF para " & strName)
   Else
   
        Dim adoStream: Set adoStream = CreateObject("adodb.stream")
    
        Const adTypeBinary = 1  ' ado typelib constantes
        Const adModeReadWrite = 3
        Const adSaveCreateOverwrite = 2
    
         With adoStream  ' setup and write the graphics file to local disk...
            .Type = adTypeBinary  ' as BINARY
            .Mode = adModeReadWrite
            .Open '= Me.wbCertiPDF.LocationURL   ' el stream
            .Write xmlHTTP.responseBody  ' escribe los datos (como binary)...
            .SaveToFile FSO_BuildPath(m_strpathToExport, strName & ".pdf"), adSaveCreateOverwrite
            .Close  ' the stream
         End With
    End If
       
Salir:
    If blnError = True Then
        MsgBox ("Fallo al crear el pdf")
    End If
    Exit Sub
Error:
    blnError = True
    'Resume 0
    Resume Salir
    
End Sub