Automatically include image and sound files in excel columns, based on a filename in another column

Question

I have a column with filenames in my excel file.

In the same folder of the excel file, I have image files in the form of that filename + '.jpg'. Also I have small mp3 files with the same filename + '.mp3'.

Now I want the image for each row to be displayed in a new column, and a play-button to play the mp3 file, in another column.

I already know the "=HYPERLINK()" function - with it, I can construct the path and link to the files. If I had a formula, which returns the objects itself, instead of only a link, this would be much better.

Is this possible?

Ideally, the multimedia files stay outside the excel file. But if it's much easier to embed the files, that is acceptable, too.

Also some non-formula-method would be ok, like some vba script, which loops over all rows.

EDIT: I found the following working code to play .wav files. I could convert all the mp3 files - any better idea?

Private Declare Function sndPlaySound Lib "winmm.dll" _
 Alias "sndPlaySoundA" (ByVal lpszSoundName As String, _
 ByVal uFlags As Long) As Long
Private Const SND_SYNC = &H0
Private Const SND_ASYNC = &H1
Private Const SND_NODEFAULT = &H2
Private Const SND_LOOP = &H8
Private Const SND_NOSTOP = &H10

Sub Test()
    If sndPlaySound("C:\WINDOWS\Media\tada.wav", SND_ASYNC Or SND_NODEFAULT) = 0 Then
        MsgBox "Unable to play sound."
    End If
End Sub

I also still need to find out how to insert a Button and run this code from it...

I read through many related questions and tried to find out how to write a custom function which can be called like a formula and returns the file as object. I feel it should be possible, but I'm not experienced enough. I don't even know how to one-time-execute some loop-script. — maf-soft, Aug 26 '14 at 13:35

user3514930 · Answer 1 · 2014-08-26T13:22:21.723

I think, with formula, you can have only a link...
A code like:

For i = 1 To 9999
    If Range("A" & i).Value = "" Then Exit For

    ActiveSheet.Pictures.Insert("e:\0\xx\" & Range("A" & i).Value & ".jpg").Select
    Selection.ShapeRange.Top = Range("B" & i).Top
    Selection.ShapeRange.Left = Range("B" & i).Left
    Selection.ShapeRange.Height = Range("B" & i).Height

    ActiveSheet.OLEObjects.Add(Filename:="e:\0\xx\" & Range("A" & i).Value & ".mp3", Link:=False, DisplayAsIcon:=False).Select
    Selection.ShapeRange.Top = Range("c" & i).Top
    Selection.ShapeRange.Left = Range("c" & i).Left
    Selection.ShapeRange.Height = Range("c" & i).Height

Next

Import Picture and MP3 starting from A1 to ... Using Column B for Image and Column C for the Object.
To lissen the sound you need to doble click on the object.
If you want a Button, the code are a little bit more complicated...
Notes:
You need to run the macro after you have built the column "A" with the name. If you want to run every time you change the files (add) you need to add a check for the row already made...

Thanks, I found out how to create and run this macro, and it works! But the mp3 file object doesn't work better than a hyperlink. After double clicking it, the default media player opens. Is it possible to play directly in the excel document? — maf-soft, Aug 26 '14 at 19:58
I found a way to play .wav files without embedding them, see my update in the question. Any idea how to do something similar with mp3 files? — maf-soft, Aug 26 '14 at 20:47

user3514930 · Accepted Answer · 2014-09-02T11:06:01.740

OK :-)))) I have already worked for you, because it's an interesting questions.
Use this code inside a Module.
Configuration:
Column A: Name.
Column B: Image.
Column C: Object Embedded. ERASED.
Column D: Button to Play.

Declaration:

Private Declare Function mciSendString Lib "winmm.dll" Alias _
   "mciSendStringA" (ByVal lpstrCommand As String, ByVal _
   lpstrReturnString As Any, ByVal uReturnLength As Long, ByVal _
   hwndCallback As Long) As Long

Dim sMusicFile As String
Dim Play

If you need a Stop Button:

Public Sub cmdStopMusic_Click()
    Play = mciSendString("close " & sMusicFile, 0&, 0, 0)
End Sub

Create the Sequence of Image and Button Objects:
You can call every time you want, it's already implemented the check the presence of line already inserted... (Upgrade !!!)

Sub CreateMP3()
    For i = 1 To 9999
        If Range("A" & i).Value = "" Then Exit For

        FoundT = False
        For e = 1 To ActiveSheet.Shapes.Count
            If ActiveSheet.Shapes.Range(e).Top = Range("C" & i).Top And ActiveSheet.Shapes.Range(e).Left = Range("C" & i).Left Then
                FoundT = True
            End If
        Next
        If FoundT = False Then
            ActiveSheet.Pictures.Insert("e:\0\A\xx\" & Range("A" & i).Value & ".jpg").Select
            Selection.ShapeRange.Top = Range("B" & i).Top
            Selection.ShapeRange.Left = Range("B" & i).Left
            Selection.ShapeRange.Height = Range("B" & i).Height

            BottoniMP3 (i)
        End If
    Next
End Sub

Creation of the Button:
In this sub you create also the connection with the action of the button. Only one action for many button...

Sub BottoniMP3(NumB As Integer)
    Dim xx As Range

    Set xx = Range("D" & NumB)
    ActiveSheet.Buttons.Add(xx.Left, xx.Top, xx.Width, xx.Height).Select
    Selection.OnAction = "'SoundMP3 """ & NumB & """'"
    Selection.Characters.Text = Range("A" & NumB).Value
End Sub

Event for the Button:
The event have a parameter to pass the number of row...

Sub SoundMP3(xx As Integer)
    ' Stop the Prev...
    Play = mciSendString("close " & sMusicFile, 0&, 0, 0)

    ' Start the New...
    sMusicFile = "E:\0\A\xx\" & Range("A" & xx).Value & ".mp3"
    Play = mciSendString("play " & sMusicFile, 0&, 0, 0)
    If Play <> 0 Then MsgBox "Can't PLAY!"
End Sub

CleanUp:
Pay attention to the parameter passed, if you delete some rows can be better to CleanUp the Sheet and rebuild:

Sub ERASEALL()
    For i = ActiveSheet.Shapes.Count To 1 Step -1
        Select Case ActiveSheet.Shapes(i).Name
            Case "Button 86":
            Case "Button 87":
            Case "Button 88":
            Case Else:
                ActiveSheet.Shapes(i).Delete
        End Select
    Next
End Sub

The Case Button xxx are the button I don't want to be erased. For example are the button I use to reduilt the sheet.
If you prefer you can pass like a parameter the name of the MP3, in that case I think you don't have prb... As you want.

FINAL !!! ;-))):
If you prefer you can add a Shape insted of Image & Button. The Shape follow the Cell dimensions:

Private Declare Function mciSendString Lib "winmm.dll" Alias _
   "mciSendStringA" (ByVal lpstrCommand As String, ByVal _
   lpstrReturnString As Any, ByVal uReturnLength As Long, ByVal _
   hwndCallback As Long) As Long

Dim sMusicFile As String

Dim PlayN

Sub xxxxMP3Sh()
    For i = 1 To 9999
        If Range("A" & i).Value = "" Then Exit For

        FoundT = False
        For e = 1 To ActiveSheet.Shapes.Count
            If ActiveSheet.Shapes.Range(e).Top = Range("B" & i).Top And ActiveSheet.Shapes.Range(e).Left = Range("B" & i).Left Then
                FoundT = True
            End If
        Next
        If FoundT = False Then
            ActiveSheet.Shapes.AddShape(msoShapeRectangle, Range("B" & i).Left, Range("B" & i).Top, Range("B" & i).Width, Range("B" & i).Height).Select
            With Selection.ShapeRange.Fill
                .Visible = msoTrue
                .UserPicture "e:\0\A\xx\" & Range("A" & i).Value & ".jpg"
                .TextureTile = msoFalse
            End With
            Selection.OnAction = "'SoundMP3Sh """ & i & """'"
        End If
    Next
End Sub

Sub SoundMP3Sh(xx As Integer)
    ' Stop the Prev...
    PlayN = mciSendString("close " & sMusicFile, 0&, 0, 0)

    ' Start the New...
    sMusicFile = "E:\0\A\xx\" & Range("A" & xx).Value & ".mp3"
    PlayN = mciSendString("play " & sMusicFile, 0&, 0, 0)
    If PlayN <> 0 Then MsgBox "Can't PLAY!"
End Sub

Sub StopPl()
        PlayN = mciSendString("close " & sMusicFile, 0&, 0, 0)
End Sub

Also I have learned a lot !!!! Good Job
Long Filename & path:
Add in the Module:

Private Declare Function GetShortPathName Lib "kernel32" Alias _
  "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal _
  lpszShortPath As String, ByVal lBuffer As Long) As Long

And in the code change the sub:

Public Function GetShortPath(ByVal sLongPath As String) As String
    Dim sShortPath  As String
    sShortPath = VBA.String(260, 0)
    If GetShortPathName(sLongPath, sShortPath, Len(sShortPath)) Then
        GetShortPath = VBA.Left(sShortPath, _
                   VBA.InStr(sShortPath, vbNullChar) - 1)
    End If
End Function

Sub SoundMP3Sh(xx As Integer)
    ' Stop the Prev...
    PlayN = mciSendString("close " & sMusicFile, 0&, 0, 0)

    ' Start the New...
    sMusicFile = "E:\0\A\xx\" & Range("A" & xx).Value & ".mp3"
    sMusicFile = GetShortPath(sMusicFile)
    PlayN = mciSendString("play " & Chr(34) & sMusicFile & Chr(34), 0&, 0, 0)
    If PlayN <> 0 Then MsgBox "Can't PLAY!"
End Sub

Cool, will try that in the evening. I'm optimistic I will find out how to insert buttons in a loop and call those Subs from them. But since you answer only part of my question, you need to complete your answer to become acceptable :) If you know a way how to return a picture or button from a formula, I would like that more than then Pictures.Insert-approach, since the pictures are not IN the cell. — maf-soft, Aug 27 '14 at 07:19
You can add a picture in a Comment: http://stackoverflow.com/questions/9776611/insert-picture-into-excel-cell or you can assign a macro directly to the picture inserted (Right Click -> Assign Macro). When you click, Play — user3514930, Aug 27 '14 at 07:55
Cool, I'm learning a lot. Thanks for your effort! Saves me a lot of time I don't have. Q: `1 to 9999` - is there no `ForEach`? — maf-soft, Aug 27 '14 at 08:07
Yes, if you have a defined Range, or if you want to Built. Otherwise you create a loop and exit from that when no data to elaborate... — user3514930, Aug 27 '14 at 08:31
Thanks for the link, there I learned that google docs has a =Image(Url) formula :) — maf-soft, Aug 27 '14 at 09:23
`mciSendString("play " & sMusicFile, 0&, 0, 0)` doesn't work with paths containing spaces. Quotes also don't help. Someone suggested using `GetShortPath`, but VBA doesn't support it? — maf-soft, Aug 31 '14 at 20:02
Did you forget to include your `GetShortPath` implementation? — maf-soft, Sep 02 '14 at 10:38
sMusicFile = Space$(256) RetVal = GetShortPathName(ActiveWorkbook.Path & "\" & Name, sMusicFile, Len(sMusicFile)) If RetVal = 0 Then MsgBox "Error GetShortPathName" Else sMusicFile = Left$(sMusicFile, RetVal) — maf-soft, Sep 02 '14 at 10:49

Automatically include image and sound files in excel columns, based on a filename in another column

2 Answers2