VBAでモニタ名を得る

gistfile1.vb

Option Explicit

Enum MONITORS
    MONITOR_DEFAULTTONULL
    MONITOR_DEFAULTTOPRIMARY
    MONITOR_DEFAULTTONEAREST
End Enum

Const PHYSICAL_MONITOR_DESCRIPTION_SIZE = 128 - 1

Type PHYSICAL_MONITOR
   hPhysicalMonitor As Long
   szPhysicalMonitorDescription(PHYSICAL_MONITOR_DESCRIPTION_SIZE * 2) As Byte
End Type


Declare Function GetPhysicalMonitorsFromHMONITOR& Lib "Dxva2.dll" (ByVal hMonitor&, ByVal dwPhysicalMonitorArraySize&, ByVal pPhysicalMonitorArray&)
Declare Function MonitorFromWindow& Lib "User32.dll" (ByVal hwnd&, ByVal dwFlags&)
Declare Function GetNumberOfPhysicalMonitorsFromHMONITOR& Lib "Dxva2.dll" (ByVal hMonitor&, ByVal pdwNumberOfPhysicalMonitors&)
Declare Function DestroyPhysicalMonitors& Lib "Dxva2.dll" (ByVal dwPhysicalMonitorArraySize&, ByVal pPhysicalMonitorArray&)

Sub hoge()

    Dim h&, cnt&, ret&
    Dim s$
    Dim st() As PHYSICAL_MONITOR

    h = MonitorFromWindow(Application.hwnd, MONITOR_DEFAULTTOPRIMARY)
    If h = 0 Then Exit Sub

    GetNumberOfPhysicalMonitorsFromHMONITOR h, VarPtr(cnt)
    If cnt = 0 Then Exit Sub
    ReDim st(0 To cnt - 1)
    ret = GetPhysicalMonitorsFromHMONITOR(h, cnt, VarPtr(st(0)))

    If ret Then
        s = st(0).szPhysicalMonitorDescription
        s = Left$(s, InStr(s, vbNullChar) - 1)
        Debug.Print s
        DestroyPhysicalMonitors cnt, VarPtr(st(0))
    End If
    
End Sub