Saltar al contenido

Hola tengo un formulario en microsof forms y descrga un excel con la respuesta esas respuestas tienen imagenes en url estoy intento mediante código cambiarla a imágenes reales pero cuando compilo no hay errores pero trae una imagen vacía y no funciona c


Recommended Posts

publicado

Hola tengo un formulario en Microsoft forms y descarga un Excel con la respuesta esas respuestas tienen imágenes en url estoy intento mediante código cambiarla a imágenes reales pero cuando compilo no hay errores pero trae una imagen vacía y no funciona  necesito la imagen para que descarga en la celda que el corresponde pero que lea por filas primero y despues pase a la siguiente fila en algunas celdas hay varias url soy nuevo en VBA por eso no he podido pero me pidieron esto para ayudar en la empresa y nada que lo condigo

 

publicado

Este es el codigo que tengo

  #If VBA7 Then
    Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
        Alias "URLDownloadToFileA" (ByVal pCaller As LongPtr, _
        ByVal szURL As String, ByVal szFileName As String, _
        ByVal dwReserved As LongPtr, ByVal lpfnCB As LongPtr) As Long
#Else
    Private Declare Function URLDownloadToFile Lib "urlmon" _
        Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
        ByVal szURL As String, ByVal szFileName As String, _
        ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#End If

Private Declare PtrSafe Function InternetSetOption Lib "wininet.dll" Alias "InternetSetOptionA" _
    (ByVal hInternet As LongPtr, ByVal dwOption As Long, ByVal lpBuffer As Any, _
    ByVal lpdwBufferLength As Long) As LongPtr
    
Private Declare PtrSafe Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
    (ByVal lpszAgent As String, ByVal dwAccessType As Long, _
    ByVal lpszProxyName As String, ByVal lpszProxyBypass As String, _
    ByVal dwFlags As Long) As LongPtr
Private Declare PtrSafe Function InternetCloseHandle Lib "wininet.dll" _
    (ByVal hInternet As LongPtr) As Long
Private Const INTERNET_OPTION_USERNAME = 28
Private Const INTERNET_OPTION_PASSWORD = 29
Private Const INTERNET_OPTION_PROXY_USERNAME = 43
Private Const INTERNET_OPTION_PROXY_PASSWORD = 44
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_OPEN_TYPE_PROXY = 3

Sub DescargarImagenes()
    Dim ws As Worksheet
    Dim rng As Range
    Dim c As Range
    Dim url() As String
    Dim i As Long
    Dim imgUrl As String
    Dim hOpen As LongPtr
    Dim lResult As LongPtr
    Dim user As String
    Dim password As String
    Dim http As Object
    Dim authSuccessful As Boolean
    Dim Imagen As Picture

    Set ws = ThisWorkbook.Sheets("Sheet1")
    Set rng = ws.Range("A1:DZ50")

    'Set rng = ws.Range("B1:D" & ws.Cells(ws.Rows.Count, "D").End(xlUp).Row)
    
    user = "ingreso correo "
    password = "ingreso contraseña"
    

    'Dim http As Object
    Set http = CreateObject("MSXML2.XMLHTTP")
   
    http.Open "GET", "https://login.microsoftonline.com/", False
    http.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:59.0) Gecko"
    http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    http.send "login=" & user & "&password=" & password & "&type=login"
    
    authSuccessful = False
    If http.Status = 200 Then
        authSuccessful = True
    End If
    
    If Not authSuccessful Then
        MsgBox "Error al iniciar sesión."
        Exit Sub
    End If
    
    hOpen = InternetOpen("VBA", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
     
    lResult = InternetSetOption(hOpen, INTERNET_OPTION_USERNAME, StrPtr(user), Len(user))
    lResult = InternetSetOption(hOpen, INTERNET_OPTION_PASSWORD, StrPtr(password), Len(password))
    
    MsgBox "Descargando imagen desde: " & imgUrl & vbNewLine & "Guardando imagen en: " & "C:\Users\aprendiz.ingenieria\Documents\pruebas\imgdescargas\" & i & ".jpg"
    For Each c In rng
        url = Split(c.Value, ";")
        For i = LBound(url) To UBound(url)
            If url(i) <> "" Then
                imgUrl = Replace(url(i), " ", "%20")
                lResult = URLDownloadToFile(0, imgUrl, "C:\ruta\de\destino\" & i & ".jpg", 0, 0)
                Debug.Print "Descargando imagen desde: " & imgUrl
                Debug.Print "Guardando imagen en: " & "C:\ruta\de\destino"
               
            End If
        Next i
    Next c
    
    MsgBox "Imágenes descargadas exitosamente."
    
End Sub
 

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.