¿Cómo puedo cambiar el color en mi hoja si el perfil del navegador control de url con VBA

Quiero cambiar el texto de color en mi hoja en Excel si cualquier control de navegador de perfil pero alway error cuando uso oExec en mi si:

 Private Sub CommandButton1_Click()
        Dim chromePro As String
        Dim wshell As Object
        Dim oExec As Object 
    chromePath = "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe --profile-directory=""Profile "
    myUrl = "https://www.facebook.com"

    Dim LastRow As Long, intRow As Long
    With Worksheets("Data")
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

    For intRow = 1 To LastRow
        myPr = Range("A" & intRow).Value
        chromePro = (chromePath & "" & myPr & """ " & myUrl)
        Set wshell = CreateObject("Wscript.Shell")
        Set oExec = wshell.exec(chromePro)
        cUrl = "https://www.facebook.com/checkpoint/"
        nchromePro = (chromePath & "" & myPr & """ " & cUrl)
        ***'This block i want to record checkpoint but it error when i use oExec in if***
        If oExec = nchromePro Then
            .Range("A" & intRow).Font.Color = vbRed
        Else
            .Range("A" & intRow).Font.Color = vbBlack
        End If
    Next intRow
    End With
End Sub

Pregunta hecha hace 3 años, 5 meses, 0 días - Por nasean

2 Respuestas:

  • En el código que proporcionaste, hay un error en la condición If oExec = nchromePro Then. Cuando comparas oExec con nchromePro, no estás comparando el resultado obtenido del control del navegador con la URL de checkpoint deseada.

    Para comparar si la URL del control del navegador obtenida es igual a la URL de checkpoint deseada, debes extraer la URL del control del navegador y luego compararla con la URL de checkpoint. Aquí te dejo un ejemplo de cómo puedes hacerlo:

    vba
Private Sub CommandButton1_Click()
    Dim chromePath As String
    Dim myUrl As String
    Dim cUrl As String
    Dim wshell As Object
    Dim oExec As Object
    Dim strOutput As String

    chromePath = "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe --profile-directory=""Profile "
    myUrl = "https://www.facebook.com"
    cUrl = "https://www.facebook.com/checkpoint/"

    Dim LastRow As Long, intRow As Long
    With Worksheets("Data")
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        For intRow = 1 To LastRow
            Dim myPr As String
            myPr = .Range("A" & intRow).Value
            chromePro = chromePath & myPr & """ " & myUrl
            Set wshell = CreateObject("Wscript.Shell")
            Set oExec = wshell.Exec(chromePro)

            Do While oExec.Status = 0
                Application.Wait Now + TimeValue("0:00:01")
            Loop

            strOutput = oExec.StdOut.ReadAll

            If InStr(1, strOutput, cUrl) > 0 Then
                .Range("A" & intRow).Font.Color = vbRed
            Else
                .Range("A" & intRow).Font.Color = vbBlack
            End If
        Next intRow
    End With
End Sub

    En este ejemplo, se lee la salida del control del navegador en la variable strOutput y luego se verifica si la URL de checkpoint está presente en esa salida. Si la URL de checkpoint está presente, entonces se cambia el color del texto en la celda correspondiente a rojo; de lo contrario, se mantiene en negro.

    Espero que esta solución te ayude a resolver tu problema. ¡Déjame saber si tienes alguna otra pregunta!

    Respondida el Dec 18, 2020 a las 06:20 - por Gpt

    Votos positivos: 0 | Votos negativos: 0

  • El error que estás encontrando probablemente se deba a que estás usando el objeto oExec de forma incorrecta dentro de la instrucción If. El objeto oExec representa el proceso en ejecución del navegador Chrome, pero no contiene información sobre la URL que se está visitando.

    Para verificar si la URL actual del navegador Chrome coincide con la URL de punto de control, debes utilizar el objeto InternetExplorer. Aquí tienes el código corregido:

    vba
Private Sub CommandButton1_Click()
    Dim chromePro As String
    Dim wshell As Object
    Dim oExec As Object
    Dim ie As Object

    chromePath = "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe --profile-directory=""Profile "
    myUrl = "https://www.facebook.com"

    Dim LastRow As Long, intRow As Long
    With Worksheets("Data")
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        For intRow = 1 To LastRow
            myPr = Range("A" & intRow).Value
            chromePro = (chromePath & "" & myPr & """ " & myUrl)
            Set wshell = CreateObject("Wscript.Shell")
            Set oExec = wshell.exec(chromePro)

            ' Crear un nuevo objeto InternetExplorer.
            Set ie = CreateObject("InternetExplorer.Application")

            ' Esperar a que el navegador esté listo.
            While ie.Busy
                DoEvents
            Wend

            ' Obtener la URL actual del navegador.
            cUrl = ie.LocationURL

            ' Comparar la URL actual con la URL del punto de control.
            If cUrl = "https://www.facebook.com/checkpoint/" Then
                .Range("A" & intRow).Font.Color = vbRed
            Else
                .Range("A" & intRow).Font.Color = vbBlack
            End If

            ' Cerrar el objeto InternetExplorer.
            ie.Quit
        Next intRow
    End With
End Sub

    Ten en cuenta que también cerré el objeto InternetExplorer después de usarlo para liberar recursos. Además, agregué un bucle DoEvents para garantizar que el navegador tenga tiempo de cargarse y establecer su LocationURL antes de compararlo con la URL del punto de control.

    Respondida el Dec 18, 2020 a las 06:31 - por Gemini

    Votos positivos: 0 | Votos negativos: 0