VBA中使用VLC ActiveX控件指定摄像头的Directshow问题

问题背景 #

Windows10 + Office 2019专业增强版环境，已安装VLC Vetinari版本并添加VideoLAN VLC ActiveX Plugin引用及控件：

• 通过Shell调用VLC可成功指定目标摄像头
• 使用VLC ActiveX控件时，:dshow-vdev参数无效，始终调用系统默认第一个摄像头，但分辨率、帧率等参数正常生效

Shell方式可行代码 #

Sub ConnectWebcamWithShell()
On Error GoTo ErrorHandler

Dim vlcPath As String
vlcPath = """C:\Program Files (x86)\VideoLAN\VLC\vlc.exe""" ' 按需调整路径

Dim webcamName As String
webcamName = "dshow:// :dshow-vdev=""Logi C270 HD WebCam"" :dshow-adev=none :dshow-size=1280x720 :dshow-fps=30"""

Dim command As String
command = vlcPath & " " & webcamName

' 执行VLC命令
Shell command, vbNormalFocus

MsgBox "摄像头已连接并按指定参数播放"
Exit Sub

ErrorHandler:
MsgBox "错误: " & Err.Description, vbCritical
End Sub

ActiveX方式失效代码 #

Sub ConnectWebcamWithOptions()
On Error GoTo ErrorHandler

Dim vlc As Object
Set vlc = CreateObject("VideoLAN.VLCPlugin.2")

' 检查VLC对象是否创建成功
If vlc Is Nothing Then
    MsgBox "无法创建VLC对象，请确保VLC已安装且ActiveX已注册。", vbCritical
    Exit Sub
End If

' 配置摄像头参数
Dim options(3) As String
options(0) = ":dshow-vdev=Logi C270 HD WebCam"
options(1) = ":dshow-adev=none"
options(2) = ":dshow-size=640x480"
options(3) = ":dshow-fps=30"

' 添加到播放列表并播放
vlc.Playlist.Add "dshow://", "WebCam", options
vlc.Playlist.Play

' 等待视频启动
Do While vlc.input.State <> 3 ' 3表示正在播放
    DoEvents
Loop

MsgBox "摄像头已连接并按指定参数播放"
Exit Sub

ErrorHandler:
MsgBox "错误: " & Err.Description, vbCritical
End Sub

解决办法 #

1. 修正参数的引号转义 #

带空格的摄像头名称需要用双层引号转义，VBA中用""表示单个双引号，确保VLC正确识别：

options(0) = ":dshow-vdev=""Logi C270 HD WebCam"""

2. 添加源前清空播放列表 #

残留的旧配置可能导致参数不生效，添加新源前先清空播放列表：

vlc.Playlist.Clear ' 清空旧列表
vlc.Playlist.Add "dshow://", "WebCam", options
vlc.Playlist.Play

3. 使用设备索引替代名称 #

如果名称方式仍失效，可通过设备索引指定（索引从0开始）：

options(0) = ":dshow-vdev=1" ' 指定第二个摄像头

可通过以下命令枚举设备获取索引：

"C:\Program Files (x86)\VideoLAN\VLC\vlc.exe" -l dshow

4. 重新注册ActiveX控件 #

若控件注册异常，以管理员身份运行命令提示符执行：

regsvr32 "C:\Program Files (x86)\VideoLAN\VLC\axvlc.dll"

修正后的完整代码 #

Sub ConnectWebcamWithOptions_Fixed()
On Error GoTo ErrorHandler

Dim vlc As Object
Set vlc = CreateObject("VideoLAN.VLCPlugin.2")

If vlc Is Nothing Then
    MsgBox "无法创建VLC对象，请确保VLC已安装且ActiveX已注册。", vbCritical
    Exit Sub
End If

' 正确转义的参数配置
Dim options(3) As String
options(0) = ":dshow-vdev=""Logi C270 HD WebCam"""
options(1) = ":dshow-adev=none"
options(2) = ":dshow-size=640x480"
options(3) = ":dshow-fps=30"

vlc.Playlist.Clear
vlc.Playlist.Add "dshow://", "WebCam", options
vlc.Playlist.Play

Do While vlc.input.State <> 3
    DoEvents
Loop

MsgBox "摄像头已连接并按指定参数播放"
Exit Sub

ErrorHandler:
MsgBox "错误: " & Err.Description, vbCritical
End Sub

内容的提问来源于stack exchange，提问作者Benoit