使用 VBA 操作网页控件

Question

提前感谢您的回答。

我制作了一个小 Excel 文档，以便天真的用户可以在 Excel 工作表中输入网页，点击按钮，然后在浏览器中全屏播放该页面中的视频，并自动循环播放视频无需任何进一步的用户交互。它基本上是创建视频幻灯片。

我最初是为 YouTube 制作的，它在那里运行良好。我现在正在尝试扩展它以使用另一个站点。它按计划工作，但需要额外的步骤。

YouTube 是使用全屏模式制作的，我可以通过编程方式访问，而这个网站嵌入了视频。 （例如：https://www.sharecare.com/video/health-topics-a-z/copd/what-can-i-do-to-prevent-my-copd-from-getting-worse）。

您可以在代码中看到我以全屏模式打开 IE（确实如此），但这是完整的网页（标题、侧边栏等）。我希望该页面中的视频是唯一的元素，全屏。

如果我实际进入该页面，我可以选择让视频全屏播放。我尝试过寻找各种方法来做到这一点，但大多数帖子都是针对其他内容或如何让视频在 Excel 中播放，而不是我正在做的事情。

Sub StartLooping()

Dim IEapp As Object
Dim VidAddr1, VidAddr2 As String
Dim AddrStrStart, AddrStrEnd As Long
Dim AddrFudge1, AddrFudge2 As Integer
Dim TimeStart, DurMin, DurSec, DurTot As Single
Dim LRAll, LRVid, LRMin, LRSec, LRVidB, LRMinB, LRSecB As Integer
Dim I As Integer

Application.EnableCancelKey = xlErrorHandler
On Error GoTo ErrorHandle


'Review Sheet
LRVid = Cells(Rows.Count, "D").End(xlUp).Row
LRMin = Cells(Rows.Count, "E").End(xlUp).Row
LRSec = Cells(Rows.Count, "F").End(xlUp).Row
LRVidB = Cells(Rows.Count, "I").End(xlUp).Row
LRMinB = Cells(Rows.Count, "J").End(xlUp).Row
LRSecB = Cells(Rows.Count, "K").End(xlUp).Row
LRAll = Cells(Rows.Count, "S").End(xlUp).Row

If LRVid <> LRMin Then
    MsgBox "You have to include video address and how long (the minutes and the seconds - use 0 if needed)"
    Exit Sub
End If

If LRVid <> LRSec Then
    MsgBox "You have to include video address and how long (the minutes and the seconds - use 0 if needed)"
    Exit Sub
End If

If LRVidB <> LRMinB Then
    MsgBox "You have to include video address and how long (the minutes and the seconds - use 0 if needed)"
    Exit Sub
End If

If LRVidB <> LRSecB Then
    MsgBox "You have to include video address and how long (the minutes and the seconds - use 0 if needed)"
    Exit Sub
End If


'Start of For-Next Loop

For I = 20 To LRAll

'Set Addr

'VidAddr1
If Len(Range("S" & I).Text) = 0 Then
    Exit Sub
    Else
        VidAddr1 = Range("S" & I).Text
End If

VidAddr2 = VidAddr1

'Set Timer
TimeStart = Timer 'Start time
DurMin = Range("T" & I).Value
DurSec = Range("U" & I).Value
DurTot = (DurMin * 60) + DurSec


'Open the web page
Set IEapp = CreateObject("Internetexplorer.Application") 'Set IEapp = InternetExplorer

    With IEapp
        .Silent = True 'No Pop-ups
        .Visible = True
        .FullScreen = True
        .Navigate VidAddr2 'Load web page

        'Keep it open for the duration
            Do While Timer < (TimeStart + DurTot)

                'Check for Esc - refers to a public function
                If KeyDown(vbKeyEscape) Then
                    IEapp.Quit
                    Set IEapp = Nothing
                    Exit Sub
                End If

            Loop

        'Close the page
            IEapp.Quit
            Set IEapp = Nothing

    End With

    If I = LRAll Then I = 19

Next I

ErrorHandle:

    MsgBox Err.Number & " " & Err.Description

Exit Sub

End Sub

我复制了代码。它工作正常。我需要的只是额外的“哦，我做到了，这就是如何去做”。

使用的浏览器是 IE，所以我可以保持简单，但如果这在另一个常见的浏览器中是可能的，那就太好了。

这是我今天（9/12）尝试的第二组

Dim IEapp As Object
Dim IEAppColl As HTMLButtonElement

'Open doc
Set IEapp = CreateObject("Internetexplorer.Application") 'Set IEapp =    InternetExplorer

    With IEapp
        .Silent = True 'No Pop-ups
        .Visible = True
        '.FullScreen = True
        .navigate "https://www.sharecare.com/video/health-topics-a-z/copd/got-copd-ask-your-doctor-about-vitamin-d"

        Do While .readyState < 4 Or .Busy
        Loop

        Set IEAppColl = IEapp.Document.getElementsByTagName("BUTTON")
        If IEAppColl.Name = "Fullscreen" Then
              IEAppColl.Click
        End If

    End With

Answer 1

对于示例 COPD 页面，它适用于 Selenium basic。您从here 安装，然后转到VBE > Tools > References > 并添加对Selenium Type Library 的引用。您还可以使用 IEDriver 来使用 InternetExplorer 而不是 Chrome（它使用 ChromeDriver）。

Option Explicit
Public Sub PlayFullScreen()
    Dim d As WebDriver, t As Date, ele As Object
    Const MAX_WAIT_SEC As Long = 10

    Set d = New ChromeDriver
    Const URL = "https://www.sharecare.com/video/health-topics-a-z/copd/what-can-i-do-to-prevent-my-copd-from-getting-worse"

    With d
        .Start "Chrome"
        .get URL
        Do
            DoEvents
            On Error Resume Next
            Set ele = .FindElementByCss("[title='Accept Cookies']")
            If Timer - t > MAX_WAIT_SEC Then Exit Do
            On Error GoTo 0
        Loop While ele Is Nothing
        Application.Wait Now + TimeSerial(0, 0, 1)
        If Not ele Is Nothing Then ele.Click
        .FindElementByCss("#myExperience").Click
        Application.Wait Now + TimeSerial(0, 0, 1)
        .FindElementByCss("[Title=Fullscreen]", timeout:=7000).Click

        Stop                                     '<==Delete me later      
        .Quit
    End With
End Sub

Answer 2

我的建议是，不要使用浏览器播放视频，而是使用视频播放器。

在“更多控件”下，您应该有一个“Windows Media Player”，可能还有其他，这取决于您安装的内容。

例如，我在 Access 表单上使用了 VLC 控件。当您安装 VLC 时，它会自动将控件添加到 Office（所以我假设必须先安装 Office。）

---

这是我在网上找到的教程：

• 链接：How to Play Video on Access Form

---

随机提示时间：

• Google 关于一个网站可能很棘手，因为例如，在 Google 搜索中使用搜索词 *YouTube* 会导致 YouTube 内容列表（视频）。

  使用 Google 的 site: 和 - 运算符排除来自特定网站的结果，例如：

  "microsoft access" form play youtube video -site:youtube.com

  ...这就是我找到上面的教程以及其他几个教程的方式。

• 使用搜索词access 也很难搜索，因为它是一个很常见的词，这就是为什么我经常将它用引号括起来，如“MS Access”或“Microsoft Access”（如上），这使得谷歌搜索这些词按顺序。

  _{(More Google tips)}