Sustituir IE para llenar Formularios de Gogle
Publicado por Miguel (9 intervenciones) el 21/07/2021 23:48:36
Hola Amigos tengo un archivo con macros el cual funcionaba muy bien para subir informacion a un formulario de google drive, pero a ultimas fechas ha presentado problemas porque el internet explorer ya no puede abrir los formularios me lanza este aviso "Actualiza tu navegador para usar Drive, Documentos, Hojas de cálculo, Sites, Presentaciones y Formularios de Google: Para usar Google Drive, Documentos, Hojas de cálculo, Sites, Presentaciones y Formularios de Google, debes usar un navegador web compatible."
Amigos Espero me ayuden, ya me ha bloqueado la carga en muchas ocasiones al principio creí que era mi conexión de Internet pero después apareció ese aviso por favor espero su apoyo
Les pongo a continuación el código del macro:
Sub Captura_Datos()
'Declaración de variables
'
Dim strTitulo As String
Dim Continuar As String
Dim TransRowRng As Range
Dim Cells As Range
Dim NewRow As Integer
Dim Limpiar As String
Dim Ulinea As Long
Dim rng As Range
Dim T As Single
'
ActiveWorkbook.Save
strTitulo = "Afiliaciones UCD"
'
Continuar = MsgBox("Dar de alta los datos?", vbYesNo + vbExclamation, strTitulo)
If Continuar = vbNo Then Exit Sub
'
Set TransRowRng = ThisWorkbook.Worksheets("PADRON").Cells(1, 1).CurrentRegion
NewRow = TransRowRng.Rows.Count + 1
With ThisWorkbook.Worksheets("PADRON")
.Cells(NewRow, 1).Value = ThisWorkbook.Sheets(2).Range("J7") 'engomado
.Cells(NewRow, 2).Value = ThisWorkbook.Sheets(2).Range("x15") ' fecha
.Cells(NewRow, 3).Value = ThisWorkbook.Sheets(2).Range("G7") ' registro
.Cells(NewRow, 4).Value = ThisWorkbook.Sheets(2).Range("G11") ' estado afiliacion
.Cells(NewRow, 5).Value = ThisWorkbook.Sheets(2).Range("D15") ' oficina
.Cells(NewRow, 6).Value = ThisWorkbook.Sheets(2).Range("D22") ' marca
.Cells(NewRow, 7).Value = ThisWorkbook.Sheets(2).Range("D26") ' tipo
.Cells(NewRow, 8).Value = ThisWorkbook.Sheets(2).Range("D24") ' modelo
.Cells(NewRow, 9).Value = ThisWorkbook.Sheets(2).Range("D28") ' linea
.Cells(NewRow, 10).Value = ThisWorkbook.Sheets(2).Range("D20") ' serie
.Cells(NewRow, 11).Value = ThisWorkbook.Sheets(2).Range("J20") ' propietario
.Cells(NewRow, 12).Value = ThisWorkbook.Sheets(2).Range("J22") ' conductores
.Cells(NewRow, 13).Value = ThisWorkbook.Sheets(2).Range("J24") ' domicilio
.Cells(NewRow, 14).Value = ThisWorkbook.Sheets(2).Range("J26") 'localidad
.Cells(NewRow, 15).Value = ThisWorkbook.Sheets(2).Range("J30") 'municipio
.Cells(NewRow, 16).Value = ThisWorkbook.Sheets(2).Range("J32") 'telefono
.Cells(NewRow, 17).Value = ThisWorkbook.Sheets(2).Range("D30") 'observaciones
End With
MsgBox "Alta exitosa en Padron Local.", vbInformation, strTitulo
strTitulo = "Afiliaciones UCD"
Continuar = MsgBox("Ya realizo las impresiones?", vbYesNo + vbExclamation, strTitulo)
Dim IE As Object
Set IE = CreateObject("InternetExplorer.application")
IE.navigate "https://docs.google.com/forms/d/17QvnTxJwghRb3s2-d2N0G9LbC-QQm-aM2LkLegH26TU/formResponse"
Do
DoEvents
Loop Until IE.ReadyState = 4
On Error GoTo Error_1
Resume_1:
IE.Document.all.Item("entry.298824880").Value = Sheets("AFILIACION").Range("ESTADO").Value
IE.Document.all.Item("entry.1883259314").Value = Sheets("AFILIACION").Range("D15").Value
IE.Document.all.Item("entry.631402180").Value = Sheets("AFILIACION").Range("J11").Value
IE.Document.all.Item("entry.1180549576").Value = Sheets("AFILIACION").Range("J28").Value
IE.Document.all.Item("entry.769845039").Value = Sheets("AFILIACION").Range("J30").Value
IE.Document.all.Item("entry.1742048913").Value = Sheets("AFILIACION").Range("J7").Value
IE.Document.all.Item("entry.648607241").Value = Sheets("AFILIACION").Range("D22").Value
IE.Document.all.Item("entry.2135222699").Value = Sheets("AFILIACION").Range("J20").Value
IE.Document.all.Item("entry.1595079757").Value = Sheets("AFILIACION").Range("D26").Value
IE.Document.all.Item("entry.718951254").Value = Sheets("AFILIACION").Range("D24").Value
IE.Document.all.Item("entry.605605117").Value = Sheets("AFILIACION").Range("D28").Value
IE.Document.all.Item("entry.1851842681").Value = Sheets("AFILIACION").Range("D20").Value
On Error GoTo 0
IE.Visible = False
IE.Document.Forms(0).submit
pag = "https://docs.google.com/forms/d/17QvnTxJwghRb3s2-d2N0G9LbC-QQm-aM2LkLegH26TU/formResponse"
If IE.LocationURL = pag Then
MsgBox "Datos Cargados Correctamente en Padron Nacional"
Else
MsgBox "Datos Cargados Correctamente en Padron Nacional"
Set IE = CreateObject("InternetExplorer.application")
IE.navigate "https://docs.google.com/forms/d/e/1FAIpQLSfs3DsVLu6F0kIfe3SqVUMb55a9wlzNWQqleCtWvNnqLkekgg/formResponse"
Do
DoEvents
Loop Until IE.ReadyState = 4
On Error GoTo Error_2
Resume_2:
IE.Document.all.Item("entry.1172945320").Value = Sheets("AFILIACION").Range("K15").Value
IE.Document.all.Item("entry.379460853").Value = Sheets("AFILIACION").Range("M15").Value
IE.Document.all.Item("entry.56908933").Value = Sheets("AFILIACION").Range("O15").Value
IE.Document.all.Item("entry.828988146").Value = Sheets("AFILIACION").Range("G7").Value
IE.Document.all.Item("entry.1405817967").Value = Sheets("AFILIACION").Range("J7").Value
IE.Document.all.Item("entry.2011907002").Value = Sheets("AFILIACION").Range("G11").Value
IE.Document.all.Item("entry.1350775608").Value = Sheets("AFILIACION").Range("D15").Value
IE.Document.all.Item("entry.298430987").Value = Sheets("AFILIACION").Range("D22").Value
IE.Document.all.Item("entry.683153751").Value = Sheets("AFILIACION").Range("D26").Value
IE.Document.all.Item("entry.1878700842").Value = Sheets("AFILIACION").Range("D24").Value
IE.Document.all.Item("entry.276133944").Value = Sheets("AFILIACION").Range("D28").Value
IE.Document.all.Item("entry.1545916454").Value = Sheets("AFILIACION").Range("D20").Value
IE.Document.all.Item("entry.2005620554").Value = Sheets("AFILIACION").Range("J20").Value
IE.Document.all.Item("entry.705832906").Value = Sheets("AFILIACION").Range("J22").Value
IE.Document.all.Item("entry.626501034").Value = Sheets("AFILIACION").Range("J24").Value
IE.Document.all.Item("entry.1045781291").Value = Sheets("AFILIACION").Range("J26").Value
IE.Document.all.Item("entry.1065046570").Value = Sheets("AFILIACION").Range("J30").Value
IE.Document.all.Item("entry.790618193").Value = Sheets("AFILIACION").Range("J32").Value
On Error GoTo 0
IE.Visible = False
IE.Document.Forms(0).submit
pag = "https://docs.google.com/forms/d/e/1FAIpQLSfs3DsVLu6F0kIfe3SqVUMb55a9wlzNWQqleCtWvNnqLkekgg/formResponse"
If IE.LocationURL = pag Then
MsgBox "Datos Cargados Correctamente en Padron Regional"
Else
MsgBox "Datos Cargados Correctamente en Padron Regional"
End If
IE.Quit
Set IE = Nothing
Exit Sub
Error_1:
T = Timer + 0.5
While T > Timer: Wend
Resume Resume_1
Error_2:
T = Timer + 0.5
While T > Timer: Wend
Resume Resume_2
End If
End Sub
Amigos Espero me ayuden, ya me ha bloqueado la carga en muchas ocasiones al principio creí que era mi conexión de Internet pero después apareció ese aviso por favor espero su apoyo
Les pongo a continuación el código del macro:
Sub Captura_Datos()
'Declaración de variables
'
Dim strTitulo As String
Dim Continuar As String
Dim TransRowRng As Range
Dim Cells As Range
Dim NewRow As Integer
Dim Limpiar As String
Dim Ulinea As Long
Dim rng As Range
Dim T As Single
'
ActiveWorkbook.Save
strTitulo = "Afiliaciones UCD"
'
Continuar = MsgBox("Dar de alta los datos?", vbYesNo + vbExclamation, strTitulo)
If Continuar = vbNo Then Exit Sub
'
Set TransRowRng = ThisWorkbook.Worksheets("PADRON").Cells(1, 1).CurrentRegion
NewRow = TransRowRng.Rows.Count + 1
With ThisWorkbook.Worksheets("PADRON")
.Cells(NewRow, 1).Value = ThisWorkbook.Sheets(2).Range("J7") 'engomado
.Cells(NewRow, 2).Value = ThisWorkbook.Sheets(2).Range("x15") ' fecha
.Cells(NewRow, 3).Value = ThisWorkbook.Sheets(2).Range("G7") ' registro
.Cells(NewRow, 4).Value = ThisWorkbook.Sheets(2).Range("G11") ' estado afiliacion
.Cells(NewRow, 5).Value = ThisWorkbook.Sheets(2).Range("D15") ' oficina
.Cells(NewRow, 6).Value = ThisWorkbook.Sheets(2).Range("D22") ' marca
.Cells(NewRow, 7).Value = ThisWorkbook.Sheets(2).Range("D26") ' tipo
.Cells(NewRow, 8).Value = ThisWorkbook.Sheets(2).Range("D24") ' modelo
.Cells(NewRow, 9).Value = ThisWorkbook.Sheets(2).Range("D28") ' linea
.Cells(NewRow, 10).Value = ThisWorkbook.Sheets(2).Range("D20") ' serie
.Cells(NewRow, 11).Value = ThisWorkbook.Sheets(2).Range("J20") ' propietario
.Cells(NewRow, 12).Value = ThisWorkbook.Sheets(2).Range("J22") ' conductores
.Cells(NewRow, 13).Value = ThisWorkbook.Sheets(2).Range("J24") ' domicilio
.Cells(NewRow, 14).Value = ThisWorkbook.Sheets(2).Range("J26") 'localidad
.Cells(NewRow, 15).Value = ThisWorkbook.Sheets(2).Range("J30") 'municipio
.Cells(NewRow, 16).Value = ThisWorkbook.Sheets(2).Range("J32") 'telefono
.Cells(NewRow, 17).Value = ThisWorkbook.Sheets(2).Range("D30") 'observaciones
End With
MsgBox "Alta exitosa en Padron Local.", vbInformation, strTitulo
strTitulo = "Afiliaciones UCD"
Continuar = MsgBox("Ya realizo las impresiones?", vbYesNo + vbExclamation, strTitulo)
Dim IE As Object
Set IE = CreateObject("InternetExplorer.application")
IE.navigate "https://docs.google.com/forms/d/17QvnTxJwghRb3s2-d2N0G9LbC-QQm-aM2LkLegH26TU/formResponse"
Do
DoEvents
Loop Until IE.ReadyState = 4
On Error GoTo Error_1
Resume_1:
IE.Document.all.Item("entry.298824880").Value = Sheets("AFILIACION").Range("ESTADO").Value
IE.Document.all.Item("entry.1883259314").Value = Sheets("AFILIACION").Range("D15").Value
IE.Document.all.Item("entry.631402180").Value = Sheets("AFILIACION").Range("J11").Value
IE.Document.all.Item("entry.1180549576").Value = Sheets("AFILIACION").Range("J28").Value
IE.Document.all.Item("entry.769845039").Value = Sheets("AFILIACION").Range("J30").Value
IE.Document.all.Item("entry.1742048913").Value = Sheets("AFILIACION").Range("J7").Value
IE.Document.all.Item("entry.648607241").Value = Sheets("AFILIACION").Range("D22").Value
IE.Document.all.Item("entry.2135222699").Value = Sheets("AFILIACION").Range("J20").Value
IE.Document.all.Item("entry.1595079757").Value = Sheets("AFILIACION").Range("D26").Value
IE.Document.all.Item("entry.718951254").Value = Sheets("AFILIACION").Range("D24").Value
IE.Document.all.Item("entry.605605117").Value = Sheets("AFILIACION").Range("D28").Value
IE.Document.all.Item("entry.1851842681").Value = Sheets("AFILIACION").Range("D20").Value
On Error GoTo 0
IE.Visible = False
IE.Document.Forms(0).submit
pag = "https://docs.google.com/forms/d/17QvnTxJwghRb3s2-d2N0G9LbC-QQm-aM2LkLegH26TU/formResponse"
If IE.LocationURL = pag Then
MsgBox "Datos Cargados Correctamente en Padron Nacional"
Else
MsgBox "Datos Cargados Correctamente en Padron Nacional"
Set IE = CreateObject("InternetExplorer.application")
IE.navigate "https://docs.google.com/forms/d/e/1FAIpQLSfs3DsVLu6F0kIfe3SqVUMb55a9wlzNWQqleCtWvNnqLkekgg/formResponse"
Do
DoEvents
Loop Until IE.ReadyState = 4
On Error GoTo Error_2
Resume_2:
IE.Document.all.Item("entry.1172945320").Value = Sheets("AFILIACION").Range("K15").Value
IE.Document.all.Item("entry.379460853").Value = Sheets("AFILIACION").Range("M15").Value
IE.Document.all.Item("entry.56908933").Value = Sheets("AFILIACION").Range("O15").Value
IE.Document.all.Item("entry.828988146").Value = Sheets("AFILIACION").Range("G7").Value
IE.Document.all.Item("entry.1405817967").Value = Sheets("AFILIACION").Range("J7").Value
IE.Document.all.Item("entry.2011907002").Value = Sheets("AFILIACION").Range("G11").Value
IE.Document.all.Item("entry.1350775608").Value = Sheets("AFILIACION").Range("D15").Value
IE.Document.all.Item("entry.298430987").Value = Sheets("AFILIACION").Range("D22").Value
IE.Document.all.Item("entry.683153751").Value = Sheets("AFILIACION").Range("D26").Value
IE.Document.all.Item("entry.1878700842").Value = Sheets("AFILIACION").Range("D24").Value
IE.Document.all.Item("entry.276133944").Value = Sheets("AFILIACION").Range("D28").Value
IE.Document.all.Item("entry.1545916454").Value = Sheets("AFILIACION").Range("D20").Value
IE.Document.all.Item("entry.2005620554").Value = Sheets("AFILIACION").Range("J20").Value
IE.Document.all.Item("entry.705832906").Value = Sheets("AFILIACION").Range("J22").Value
IE.Document.all.Item("entry.626501034").Value = Sheets("AFILIACION").Range("J24").Value
IE.Document.all.Item("entry.1045781291").Value = Sheets("AFILIACION").Range("J26").Value
IE.Document.all.Item("entry.1065046570").Value = Sheets("AFILIACION").Range("J30").Value
IE.Document.all.Item("entry.790618193").Value = Sheets("AFILIACION").Range("J32").Value
On Error GoTo 0
IE.Visible = False
IE.Document.Forms(0).submit
pag = "https://docs.google.com/forms/d/e/1FAIpQLSfs3DsVLu6F0kIfe3SqVUMb55a9wlzNWQqleCtWvNnqLkekgg/formResponse"
If IE.LocationURL = pag Then
MsgBox "Datos Cargados Correctamente en Padron Regional"
Else
MsgBox "Datos Cargados Correctamente en Padron Regional"
End If
IE.Quit
Set IE = Nothing
Exit Sub
Error_1:
T = Timer + 0.5
While T > Timer: Wend
Resume Resume_1
Error_2:
T = Timer + 0.5
While T > Timer: Wend
Resume Resume_2
End If
End Sub
- Afiliaciones-2021-UCD_NEW-1.rar(380,2 KB)
Valora esta pregunta


0