Splash screen with video?

Hi all,
has anyone tried adding a splashscreen to a file using a videoclip?
Can you embed media player in a userform and auto run it?
If anyone has an ideas or examples if they have done it before I would appreciate it please.

Many thanks in advance.

Hi Johnny,

The answer is yes and yes.

There are prerequisites (explained in the attached file) that may be required in order to:
a. Run Windows Media Player in a UserForm or a Spreadsheet
b. Avoid a Nasty Message from Excel that indicates 'Windows Media Player' (which is an 'ActiveX' Control) may destroy the world

It is not trivial to fix the 'Warning Messages' and changes to the Windows Registry may be involved.

The attached .zip file contains:
a. LJMWindowsMediaPlayerVideoMaster.xlsm - Excel file
b. SampleThreeSecondVideo.mp4 - Sample 3 second video in .mp4 format
c.SampleSixSecondVideo.mp4 - Sample 6 second video in .mp4 format


The attached Excel file has been tested in 32 bit Excel 2016 on Windows 10. The file can:
a. Run 'Windows Media Player' from the Spreadsheet
b. Run 'Windows Media Player' from a UserForm
c. Run 'Windows Media Player' Full Screen from a UserForm

The file was tested with the attached .mp4 files only which must be in the same folder as the Excel File.

There is code in Workbook_Open() to run 'Windows Media Player' when the file opens which is COMMENTED OUT because it is poor form to upload a file that automatically runs a Macro.

Some typical code excerpt to run Windows Media Player:

Sub PlayWindowsMediaPlayerInUserFormCodeExcerpt(myControl As Object)

  Const sVideoFileNAME = "SampleSixSecondVideo.mp4"
  
  Dim myUserForm As Object
 
  'Create the UserForm Object
  Set myUserForm = myControl.Parent
  
  'Create the File Path (Folder) - the folder that contains this file
  sPath = ThisWorkbook.Path
  
  'Make sure the Path contains a trailing Backslash
  If Right(sPath, 1) <> "\" Then
    sPath = sPath & "\"
  End If
  
  'Create the Path and File Name Combination
  sPathAndVideoFileNameCombination = sPath & sVideoFileNAME
  
  
  'Turn Off 'AutoStart'
  myControl.settings.autoStart = False
  
  'Set the User Interface Mode
  myControl.uiMode = "full"        '  'full' or 'mini' or 'none' or 'invisible'
  
  'Set the Play Count to 1
  myControl.settings.playCount = 1
  
  'Load the Video File
  myControl.Url = sPathAndVideoFileNameCombination
  
  'Stretch the 'Windows Media Player' over the Entire UserForm
  myControl.stretchToFit = True
  
  'Play the Video
  myControl.Controls.Play

End Sub

Lewis

Hi Lewis.
Wow. thank you. Very detailed, and very informative.
It will take me a little while to digest this, and I am sure I will have questions - but thank you so much for this. One initial question: the code looks for a filepath to the video files. Is there a way to embed the videofile within excel, then simply hide the worksheet it is embedded in?

Is there a way to embed the videofile within excel, then simply hide the worksheet it is embedded in?

There are many ways to do what you want in addition to the examples below. You can put the file name in the Spreadsheet or Hard Code the File Name in the Code.

Sub WindowsMediaPlayerUrlExamples()

  Dim sVideoFileName As String
  Dim sPathAndVideoFileNameCombination As String

  'Load the Video File (from line 332 in code module 'ModMain' for Windows Media Player on the Spreadsheet) or
  'Load the Video File (from line 197 in code module 'ModUserFormSplashScreen' for Windows Media Player on the UserForm)
  myControl.Url = sPathAndVideoFileNameCombination
  
  'or
  myControl.Url = "C:\Users\Owner\Documents\ExcelAndVba\abc.mp4"

  'or to use the same folder as the file that contains the code
  sVideoFileName = "abc.mp4"
  sPathAndVideoFileNameCombination = ThisWorkbook.Path & "\" & sVideoFileName
  myControl.Url = sPathAndVideoFileNameCombination

  'or to use the same folder as the file that contains the code and get the file name from the spreadsheet
  sVideoFileName = ThisWorkbook.Sheets("SheetXYZ").Range("D4").Value
  sPathAndVideoFileNameCombination = ThisWorkbook.Path & "\" & sVideoFileName
  myControl.Url = sPathAndVideoFileNameCombination
  

  'or to get the folder and file name from the spreadsheet using an intermediate value (easier to debug)
  sPathAndVideoFileNameCombination = ThisWorkbook.Sheets("SheetXYZ").Range("D4").Value
  myControl.Url = sPathAndVideoFileNameCombination
  
  'or to get the folder and file name from the spreadsheet directly (not recommended - difficult to debug)
  myControl.Url = ThisWorkbook.Sheets("SheetXYZ").Range("D4").Value


End Sub

The following tips may help you.

To enable Macros and to Run Macros see the following:
http://office.microsoft.com/en-us/ex...010031071.aspx
http://office.microsoft.com/en-us/ex...010014113.aspx
If help is still needed do a google search for 'youtube excel enable macro' and/or 'youtube excel run macro'.

To access Visual Basic (VBA) see:
http://www.ablebits.com/office-addin...a-macro-excel/
a. Click on any cell in the Excel Spreadsheet (may not be needed).
b. ALT-F11 to get to VBA.
c. CTRL-R to get project explorer (if it isn't already showing).
d. Double Click on a 'Module Name' in 'Project Explorer' to see code for that module.

Debugger Secrets:
a. Press 'F8' to single step (goes into subroutines and functions).
b. Press SHIFT 'F8' to single step OVER subroutines and functions.
c. Press CTRL 'F8' to stop at the line where the cursor is.
d. 'Left Click' the margin to the left of a line to set (or clear) a BREAKPOINT.
e. Press CTRL 'G' to open the IMMEDIATE WINDOW. 'debug.print' statements send their
output to the IMMEDIATE WINDOW.
f. Select View > Locals to see all variables while debugging.
g. To automatically set a BREAKPOINT at a certain location put in the line:
'Debug.Assert False'
h. To conditionally set a BREAKPOINT at a certain location put in lines similar to:
if i >= 20 and xTV20 > 99.56 then
Debug.Assert False
endif
i. A variable value will be displayed by putting the cursor over the variable name.

To manually set a breakpoint, see http://www.wiseowl.co.uk/blog/s196/breakpoints.htm

Lewis

Many thanks for that.
I have tried embedding the MP4 file, and I believe the only way is embed as an object, which I have done. However, using the last two lines of code above, I can name the sheet, but the object doesn't appear to have a range as an object. Is importing as an object the best way please?
Many thanks in advance.

Hi,

Thanks for the rep points. Your original question and your need to embed the object both created an opportunity to work with things I haven't worked with previously. Thank you.

Is there a way to embed the videofile within excel, then simply hide the worksheet it is embedded in?

Take 2. I'm sorry I misunderstood the question.

Yes, you are correct, you have to Embed an Object, which I was able to do successfully.

The procedure is (in Excel 2016):

To embed Video File see Method 2 in https://www.datanumen.com/blogs/2-ef...cel-worksheet/
a. Insert > Object (Object is all the way to the right) > Create From File > Browse
b. Select the File > Insert > Leave Both CheckBoxes UNCHECKED > OK
c. Double Click the Object to play in the Default Application for that type of file.
d. NOTE: After playing is completed, the Application remains OPEN.

You don't have to put the embedded file in another Sheet. It can be hidden in plain sight and nobody will know it exists.

The way the embedded file works is:
a. You embed the file.
b. Excel creates a temporary file in the Temporary work area (on my computer in C:\Users\Owner\AppData\Local\Temp\ ).
c. When Excel closes the temporary file and (it's folder) are deleted by Excel.

Thanks to code I was lucky enough to find, I was successful in accessing the temporary file and playing the video in Windows Media Player without the need for the External copy of Windows Media Player.

I need several days to make what I did, ready for prime time. I will probably post an updated file with Embedded Video files sometime next week.

Lewis

Many thanks.
I look forward to it!

Code from previous post continued:

Sub CopyEmbeddedFileToFolderContainingThisFile()
  'This Copies an Embedded File to the Folder that contains this file
  'Input File Name is Obtained from Cell (sMainSheetVideoFileNameCELL = 'P26')
  '
  'NOTE: Embedded file may contain Extra characters after the 'Extension Name'
  '      Embedded file name is similar but not the same as the Extracted File
  '      e.g. 'abc.mp4' as a temporary file may be 'abc (2) .mp4'
  '
  'An Existing File will be overwritten
  

  Dim myWorksheet As Worksheet
  Set myWorksheet = ActiveSheet

  '''''''''''''''''''''''''''''''''''''''''''
  
  Dim bDestinationFileExists As Boolean

  Dim sDestinationPathAndFileName As String
  Dim sPath As String
  Dim sPathAndVideoFileNameCombinationForEmbeddedTemporaryFile As String
  Dim sVideoFileName As String
  Dim sVideoFileBaseName As String
  Dim sVideoFileExtension As String
  Dim sFileNameMask As String
  
  'Get the Path for the file that contains this code
  sPath = ThisWorkbook.Path
  
  'Make sure the Path contains a 'Trailing BackSlash'
  If Right(sPath, 1) <> "\" Then
    sPath = sPath & "\"
  End If
  
  'Get the File Name
  sVideoFileName = Trim(myWorksheet.Range(sMainSheetVideoFileNameCELL).Value)
  If Len(sVideoFileName) = 0 Then
    MsgBox "NOTHING DONE." & vbCrLf & _
           "The Video File Name in cell '" & sMainSheetVideoFileNameCELL & "' is EMPTY."
    GoTo MYEXIT
  End If
  
  'Get the Video File 'Base' Name and 'Extension'
  sVideoFileBaseName = LjmExtractBaseFileName(sVideoFileName)
  sVideoFileExtension = LjmExtractExtension(sVideoFileName)
  
  'Create the 'File Mask'  (e.g. 'abc.mp4' becomes '*\abc*.mp4*')
  'NOTE: Actual File Name in the Temporary Area may have an trailing NULL Character (ASCII ZERO)
  sFileNameMask = "*\" & sVideoFileBaseName & "*" & sVideoFileExtension & "*"

  'Get the Source File Name
  sPathAndVideoFileNameCombinationForEmbeddedTemporaryFile = GetEmbeddedPathAndFileName(myWorksheet, sFileNameMask)
  If Len(sPathAndVideoFileNameCombinationForEmbeddedTemporaryFile) = 0 Then
    MsgBox "Could not find Embedded File with Mask of '" & sFileNameMask & "'"
    GoTo MYEXIT
  End If
  
  'Get the Destination File Name
  sDestinationPathAndFileName = sPath & sVideoFileName
  
  'Copy the File
   FileCopy sPathAndVideoFileNameCombinationForEmbeddedTemporaryFile, sDestinationPathAndFileName
  
  'Determine if the 'Destination File Exists'
  bDestinationFileExists = LJMFileExists(sDestinationPathAndFileName)

  If bDestinationFileExists = True Then
    MsgBox "'" & sVideoFileName & "' was copied to the folder that contains this file."
  Else
    MsgBox "'" & sVideoFileName & "' COULD NOT be copied to the folder that contains this file. REASON UNKNOWN."
  End If

MYEXIT:
End Sub

Sub DisplayAllActiveXObjectsOnActiveSheet()
  'This Displays All 'ActiveX' Objects on the 'Active Sheet'
  
  Dim myOleObject As OLEObject
  
  Dim iCount As Long
  
  ' Loop through all our OLE Objects
  For Each myOleObject In ActiveSheet.OLEObjects
  
    'Increment the Counter
    'Make the Object Visible
    iCount = iCount + 1
    myOleObject.Visible = True
    
  Next myOleObject
  
  'Display a Completion Message
  Application.ScreenUpdating = True
  If iCount = 0 Then
    MsgBox "There are NO 'ActiveX' Objects on the Current Sheet to Display."
  ElseIf iCount = 1 Then
    MsgBox "The ONLY 'ActiveX' Object on the Current Sheet is Now Visible."
  Else
    MsgBox "All " & iCount & "  'ActiveX' Objects on the Current Sheet are now Visible."
  End If
  
End Sub

Sub HideAllActiveXObjectsExceptWindowsMediaPlayerOnActiveSheet()
  'This Hides All 'ActiveX' Objects on the 'Active Sheet' except 'Windows Media Player'
  
  Dim myOleObject As OLEObject
  
  Dim iCount As Long
  
  Dim sObjectNameUpperCase As String
  Dim sMessage As String
  Dim sMessage1 As String
  
  sMessage1 = "Windows Media Player is NOT on the 'Active Sheet'."
  
  
  ' Loop through all our OLE Objects
  For Each myOleObject In ActiveSheet.OLEObjects
  
    'Get the Object Name as Upper Case
    sObjectNameUpperCase = UCase(myOleObject.Name)
  
    If sObjectNameUpperCase Like "WINDOWSMEDIAPLAYER*" Then
    
      If ActiveSheet.OLEObjects.Visible = True Then
        sMessage1 = "Windows Media Player remains Visible on the 'Active Sheet'."
      Else
        sMessage1 = "Windows Media Player remains Hidden on the 'Active Sheet'."
      End If
    
    Else
  
      'Increment the Counter
      'Make the Object Hidden
      iCount = iCount + 1
      myOleObject.Visible = False
    
    End If
    
  Next myOleObject
  
  'Create Part 1 of the Completion Message
  If iCount = 0 Then
    sMessage = "There are NO 'ActiveX' Objects on the Current Sheet to Hide."
  ElseIf iCount = 1 Then
    sMessage = "The ONLY 'ActiveX' Object on the Current Sheet is Now Hidden."
  Else
    sMessage = "All " & iCount & "  'ActiveX' Objects on the Current Sheet are now Hidden."
  End If
  
  
  'Display a Completion Message
  Application.ScreenUpdating = True
  MsgBox sMessage & vbCrLf & vbCrLf & sMessage1
  
End Sub

Function LjmExtractPath(sPathAndName As String)
  'This extracts the path with a trailing '\'
  
  LjmExtractPath = Left(sPathAndName, InStrRev(sPathAndName, "\"))

End Function

Function LjmExtractFullFileName(sPathAndName As String)
  'This extracts the file name (including the extension)
  
  Dim iPos As Integer
  
  If Len(sPathAndName) > 0 Then
    iPos = InStrRev(sPathAndName, "\", Len(sPathAndName))
    If iPos > 0 Then
      LjmExtractFullFileName = Mid(sPathAndName, iPos + 1, Len(sPathAndName))
    Else
      LjmExtractFullFileName = sPathAndName
    End If
  End If
  
End Function

Function LjmExtractBaseFileName(sPathAndName As String)
  'This extracts the file name (without the extension)

  Dim iPos As Integer
  Dim sFullFileName As String
  
  sFullFileName = LjmExtractFullFileName(sPathAndName)
  
  If Len(sFullFileName) > 0 Then
    iPos = InStrRev(sFullFileName, ".")
    If iPos > 0 Then
      LjmExtractBaseFileName = Mid(sFullFileName, 1, iPos - 1)
    Else
      LjmExtractBaseFileName = sFullFileName
    End If
  End If
End Function

Function LjmExtractExtension(sPathAndName As String)
  'This extracts the file extension with the '.' included
  
  Dim iPos As Integer
  
  If Len(sPathAndName) > 0 Then
    iPos = InStrRev(sPathAndName, ".")
    If iPos > 0 Then
      LjmExtractExtension = Mid(sPathAndName, iPos)
    End If
  End If
  
End Function

Function LJMFileExists(sPathAndFullFileName As String) As Boolean
  'This returns TRUE if a file exists and FALSE if a file does NOT exist
  
  Dim iError As Integer
  Dim iFileAttributes As Integer

  On Error Resume Next
  iFileAttributes = GetAttr(sPathAndFullFileName)
     
  'Check the internal error  return
  iError = Err.Number
  Select Case iError
    Case Is = 0
        iFileAttributes = iFileAttributes And vbDirectory
        If iFileAttributes = 0 Then
          LJMFileExists = True
        Else
          LJMFileExists = False
        End If
    Case Else
        LJMFileExists = False
  End Select

  On Error GoTo 0

End Function

Lewis

Hi Lewis.
Very informative. Thank you. I will need some time to digest this for sure. One initial question: When opening, the embedded file will not play. It states file not found - even though I can see it embedded.
When clicking on the button copy embedded file, it returns the message could not find embedded file (again, I can see the two files embedded. I have tried manually adding the files to the desktop etc. but to no avail.
Could you please advise where I have gone wrong?
Many thanks.

Hi,

Could you please advise where I have gone wrong?

Sorry for the problems you are having. We may be at a dead end.

On my computers, when the Excel file is opened, each embedded file is stored in a temporary file on on my computer in the folder C:\Users\Owner\AppData\Local\Temp\
In 32 bit Excel 2010 the temporary files are stored in that folder. In 32 bit Excel 2016 the temporary files are stored in a temporary subfolder in that folder.

My speculation is that you did not do anything wrong. I see from your profile that you are using Excel 2019. Excel may handle temporary files in a different manner in Excel 2019, than in previous versions of Excel.

Please download the attached file which started out as code that was in my most recent upload. I added diagnostic output to the code. Click the CommandButton on Sheet1 to run the Diagnostic Macro. Save the file, and Upload the file in this thread.

That may help us find a solution. Sheet '200505.103958' is the output when run on my computer.

Code folllows:

Option Explicit

'Code from this module is Common to Windows Media Player in the Spreadsheet and on UserForms

'Reference: https://danny.fyi/embedding-and-accessing-a-file-in-excel-with-vba-and-ole-objects-4d4e7863cfff
'Thank you Danial Chowdhury

#If VBA7 And Win64 Then
    ' 64 bit Excel
    'The following line is supposed to be RED in 32 bit Excel
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
    ' 32 bit Excel
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

#If VBA7 Then
  '64 Bit Excel
  Private Declare PtrSafe Function CloseClipboard& Lib "user32" ()
  Private Declare PtrSafe Function OpenClipboard& Lib "user32" (ByVal hWnd&)
  Private Declare PtrSafe Function EmptyClipboard& Lib "user32" ()
  Private Declare PtrSafe Function GetClipboardData& Lib "user32" (ByVal wFormat&)
  Private Declare PtrSafe Function GlobalSize& Lib "kernel32" (ByVal hMem&)
  Private Declare PtrSafe Function GlobalLock& Lib "kernel32" (ByVal hMem&)
  Private Declare PtrSafe Function GlobalUnlock& Lib "kernel32" (ByVal hMem&)
  Private Declare PtrSafe Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length&)
#Else
  '32 Bit Excel
  Private Declare Function CloseClipboard& Lib "user32" ()
  Private Declare Function OpenClipboard& Lib "user32" (ByVal hWnd&)
  Private Declare Function EmptyClipboard& Lib "user32" ()
  Private Declare Function GetClipboardData& Lib "user32" (ByVal wFormat&)
  Private Declare Function GlobalSize& Lib "kernel32" (ByVal hMem&)
  Private Declare Function GlobalLock& Lib "kernel32" (ByVal hMem&)
  Private Declare Function GlobalUnlock& Lib "kernel32" (ByVal hMem&)
  Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length&)
#End If

Public iGblOutputRow As Long
Public wsGblOutput As Worksheet

Sub AccessEmbeddedObjectPathsAndFileNamesDiagnostic()

  Const sRoutineName = "AccessEmbeddedObjectPathsAndFileNamesDiagnostic()"

  Dim wb As Workbook
  Dim wsSheet1 As Worksheet
  
  'Initialize the Output Row Number
  iGblOutputRow = 0
  
  'Create the Worksheet Objects
  Set wb = ThisWorkbook
  Set wsSheet1 = wb.Sheets("Sheet1")
  
  Set wsGblOutput = wb.Sheets.Add(After:=Sheets(wb.Sheets.Count))
  wsGblOutput.Name = Format(Now(), "yymmdd.hhmmss")
  wsGblOutput.Cells.Font.Name = "Calibri"
  wsGblOutput.Cells.Font.Size = 11
  Call DiagnosticOutput(sRoutineName, "Start", "")
  
  
  'Code being tested starts after this line
  ''''''''''''''''''''''''''''''''''''''''''''''
  ''''''''''''''''''''''''''''''''''''''''''''''
  
  Dim wks As Worksheet

  Dim myOleObject As OLEObject
  
  Dim i As Long
  Dim iCount As Long
  
  Dim sEmbeddedFileName As String
  Dim sSheetName As String
  
  For Each wks In ThisWorkbook.Worksheets
  
    'Get the 'Sheet Name'
    sSheetName = wks.Name
  
    ' Loop through all our OLE Objects to find the one we want.
    For Each myOleObject In wks.OLEObjects
  
      'Debug.Print "myOleObject.Name = " & myOleObject.Name
    
      'Get the Embedded File Name (if any)
      ' We try to grab the embedded file name.  We call this twice.
      For i = 1 To 5
        sEmbeddedFileName = GetOLETempPath(myOleObject)
        If LCase(sEmbeddedFileName) Like "*.mp4*" Then
          Exit For
        End If
      Next i
    
      'If the Name is NOT BLANK - Display the File Path and File Name Combination
      If Len(sEmbeddedFileName) > 0 Then
    
        iCount = iCount + 1
        Debug.Print iCount, sSheetName, sEmbeddedFileName
        Dim sMessage As String
        sMessage = iCount & "  " & sSheetName & "  " & sEmbeddedFileName
        Call DiagnosticOutput(sRoutineName, "100", sMessage)

    
      End If
      
      'Only process the first Embedded file name
      Exit For
    
    Next myOleObject
  
  Next wks
  
  If iCount = 0 Then
    Call DiagnosticOutput(sRoutineName, "", "There were NO Embedded Objects 'ActiveX' Objects found.")
  End If
  
  
  ''''''''''''''''''''''''''''''''''''''''''''''
  ''''''''''''''''''''''''''''''''''''''''''''''
  'Code being tested ends before this line
  
  
  'Put the Focus on the Output Sheet
  'AutoFit the Output Columns
  wb.Activate
  wsGblOutput.Select
  wsGblOutput.Columns("A:B").AutoFit

  Call DiagnosticOutput(sRoutineName, "End", "")
  'Clear Object Pointers
  Set wb = Nothing
  Set wsSheet1 = Nothing
  Set wsGblOutput = Nothing
  
End Sub

Private Function GetOLETempPath(obj As OLEObject) As String
  'Reference: https://danny.fyi/embedding-and-accessing-a-file-in-excel-with-vba-and-ole-objects-4d4e7863cfff
  'Thank you Danial Chowdhury

    Const sRoutineName = "GetOLETempPath()"
    Call DiagnosticOutput(sRoutineName, "Start", "")
    Dim sMessage As String

    Dim B() As Byte, Pos&, iEnd&, iStart&, iLength&
    Dim Header As String

    obj.Copy ' (49156 = Native format)
    sMessage = "Before Exit Function"
    Call DiagnosticOutput(sRoutineName, "050", sMessage)
    If Not GetData(49156, B) Then Exit Function
    sMessage = "After Exit Function"
    Call DiagnosticOutput(sRoutineName, "060", sMessage)
    Dim Buffer$
    Buffer = StrConv(B, vbUnicode)
    
    Header = Chr$(0) & Chr$(0) & Chr$(3) & Chr$(0)
    Pos = InStr(Buffer, Header)
    ' To do: probably check if we reached EOF
    If Pos Then
        iStart = Pos + 8
        iEnd = InStr(iStart + 1, Buffer, Chr$(0)) + 1 'Inc Null terminator
        'iEnd = iStart + 10
        iLength = iEnd - iStart
    End If
    
    GetOLETempPath = Mid(Buffer, iStart, iLength)
    'Debug.Print (GetOLETempPath)
    
    sMessage = "Len(GetOLETempPath) = '" & Len(GetOLETempPath) & "'"
    Call DiagnosticOutput(sRoutineName, "100", sMessage)

    sMessage = "Path = '" & GetOLETempPath & "'"
    Call DiagnosticOutput(sRoutineName, "100", sMessage)
    
    
    On Error Resume Next
    If Len(Dir(GetOLETempPath)) = 0 Then
        GetOLETempPath = ""
    End If
    If Err.Number <> 0 Then
      Err.Clear
      GetOLETempPath = ""
    End If
    On Error GoTo 0
    
    ''''''''''''''''''''''''''''''
    'diagnostic starts here
    ''''''''''''''''''''''''''''''
    Dim i As Long
    Dim iPos As Long
    Dim c As String
    Dim cc As String
    Dim iValue As Long
    For i = 1 To iEnd + 10
      c = Mid(Buffer, i, 1)
      iValue = Asc(c)
      If iValue >= 32 And iValue <= 126 Then
        cc = c
      Else
        cc = "Not Printable"
      End If
      sMessage = "Buffer   " & Format(i, "000   ") & iValue & "   '" & cc & "'"
      Call DiagnosticOutput(sRoutineName, "200", sMessage)
    Next i
    
    For i = 1 To iLength
      c = Mid(GetOLETempPath, i, 1)
      iValue = Asc(c)
      If iValue >= 32 And iValue <= 126 Then
        cc = c
      Else
        cc = "Not Printable"
      End If
      sMessage = "GetOLETempPath   " & Format(i, "000   ") & iValue & "   '" & cc & "'"
      Call DiagnosticOutput(sRoutineName, "250", sMessage)
    Next i
    
    
    
    
    iPos = InStr(Buffer, ".mp4")
    sMessage = "InStr(Buffer, "".mp4"") = " & iPos
    Call DiagnosticOutput(sRoutineName, "300", sMessage)
    
    iPos = InStr(Buffer, "embedded")
    sMessage = "InStr(Buffer, ""embedded"") = " & iPos
    Call DiagnosticOutput(sRoutineName, "310", sMessage)
    
    iPos = InStr(Buffer, ".mp4")
    sMessage = "Pos, iStart, iEnd, iLength = " & Pos & "  " & iStart & "  " & iEnd & "  " & iLength
    Call DiagnosticOutput(sRoutineName, "400", sMessage)
        
    Call DiagnosticOutput(sRoutineName, "End", "")
     
End Function

Private Function GetData(ByVal Format&, abData() As Byte) As Boolean
'Reference: https://danny.fyi/embedding-and-accessing-a-file-in-excel-with-vba-and-ole-objects-4d4e7863cfff
'Thank you Danial Chowdhury

    Const sRoutineName = "GetData()"
    Call DiagnosticOutput(sRoutineName, "Start", "")

    Dim hWnd&, Size&, Ptr&
    If OpenClipboard(0&) Then
        ' Get memory handle to the data
        hWnd = GetClipboardData(Format)
        ' Get size of this memory block
        If hWnd Then Size = GlobalSize(hWnd)
            ' Get pointer to the locked memory
        If Size Then Ptr = GlobalLock(hWnd)
        
        If Ptr Then
            ' Resize the byte array to hold the data
            ReDim abData(0 To Size - 1) As Byte
            ' Copy from the pointer into the array
            CopyMem abData(0), ByVal Ptr, Size
            ' Unlock the memory
            Call GlobalUnlock(hWnd)
            GetData = True
        End If
        EmptyClipboard
        CloseClipboard
        DoEvents
    
        Dim sMessage As String
        sMessage = "hWnd, Size, Ptr  = " & hWnd & "  " & Size & "  " & Ptr
        Call DiagnosticOutput(sRoutineName, "100", sMessage)
    
    End If
    Call DiagnosticOutput(sRoutineName, "End", "")
End Function

Sub DiagnosticOutput(sRoutineName As String, sLocation As String, sText As String)

  'Increment the Output Row Number
  iGblOutputRow = iGblOutputRow + 1
  
  wsGblOutput.Cells(iGblOutputRow, "A").Value = sRoutineName
  wsGblOutput.Cells(iGblOutputRow, "B").Value = sLocation
  wsGblOutput.Cells(iGblOutputRow, "C").Value = sText

End Sub

Lewis