'AVI ファイルを再生するサンプルマクロ

Option Explicit

Declare Function mciSendString Lib "WINMM.DLL" Alias "mciSendStringA" ( _
    ByVal lpszCommand As String, ByVal lpszReturnSting As String, _
    ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

Function mssOpen(ByVal sFileName As String) As Long
    Dim iRet As Long
    Dim sRet As String
    sRet = String(255, Chr(0))
    iRet = mciSendString("close avi1", sRet, 255, 0)
    iRet = mciSendString("open " & sFileName & _
        " type avivideo alias avi1", sRet, 255, 0)
    If iRet = 0 Then
        mssOpen = 1
    End If
End Function

Function mssClose() As Long
    Dim iRet As Long
    Dim sRet As String
    sRet = String(255, Chr(0))
    iRet = mciSendString("close avi1", sRet, 255, 0)
    If iRet = 0 Then
        mssClose = 1
    End If
End Function

Function mssPlay() As Long
    Dim iRet As Long
    Dim sRet As String
    sRet = String(255, Chr(0))
    iRet = mciSendString("play avi1", sRet, 255, 0)
    If iRet = 0 Then
        mssPlay = 1
    End If
End Function

Function mssPlayReverse() As Long
    Dim iRet As Long
    Dim sRet As String
    sRet = String(255, Chr(0))
    iRet = mciSendString("play avi1 reverse", sRet, 255, 0)
    If iRet = 0 Then
        mssPlayReverse = 1
    End If
End Function

Function mssSeekToStart() As Long
    Dim iRet As Long
    Dim sRet As String
    sRet = String(255, Chr(0))
    iRet = mciSendString("seek avi1 to start", sRet, 255, 0)
    If iRet = 0 Then
        mssSeekToStart = 1
    End If
End Function

Function mssSeekToEnd() As Long
    Dim iRet As Long
    Dim sRet As String
    sRet = String(255, Chr(0))
    iRet = mciSendString("seek avi1 to end", sRet, 255, 0)
    If iRet = 0 Then
        mssSeekToEnd = 1
    End If
End Function

Function mssPause() As Long
    Dim iRet As Long
    Dim sRet As String
    sRet = String(255, Chr(0))
    iRet = mciSendString("pause avi1", sRet, 255, 0)
    If iRet = 0 Then
        mssPause = 1
    End If
End Function


Sub OpenAviFile()
    Dim vFileName As Variant
    vFileName = Application.GetOpenFilename("AVI ファイル (*.avi),*.avi")
    If VarType(vFileName) <> vbString Then
        Exit Sub
    End If
    If mssOpen(vFileName) <> 0 Then
        mssPlay
    End If
End Sub