Visual Basic para Aplicaciones - Sustituir IE para llenar Formularios de Gogle

Life is soft - evento anual de software empresarial
 
Vista:
sin imagen de perfil
Val: 29
Ha aumentado su posición en 2 puestos en Visual Basic para Aplicaciones (en relación al último mes)
Gráfica de Visual Basic para Aplicaciones

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
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder