Fade volume of background media on specific slide in PowerPoint using VBA - vba

Question

I have a PowerPoint which begins with a a media file automatically playing. The first slide is programmed to transition after 20 seconds, all the while the music keeps playing. I would like for it to keep playing for the duration of the slideshow, but fade to a lower volume once the second slide appears and remain that way for the rest of the presentation. I've looked at this Powerpoint change sound effect volume in macro but it doesn't seem to satisfy my needs.
I tried this:
Sub fadeVolSlideChange(ByVal ShowPos As SlideShowWindow)
Dim ShowPos As Integer
Dim bkgMusic As Shape
Dim Step As Long
ShowPos = ShowPos.View.CurrentShowPosition
Set bkgMusic = ActiveWindow.Selection.ShapeRange(1)
If ShowPos = 2 Then
Set Step = 0.05
For i = 1 To 0.5
With bkgMusic.MediaFormat
.Volume = i
.Muted = False
End With
i = i - Step
Application.Wait (Now + 0.0000025)
Next i
End If
End Sub
With no luck. Thoughts?
Here's the latest edit (still no luck getting it to work):
Sub OnSlideShowPageChange()
Dim i As Integer
Dim bkgMusic As Shape
Dim bkgVol As Long
Dim inc As Long
i = ActivePresentation.SlideShowWindow.View.CurrentShowPosition
Set bkgMusic = ActivePresentation.Slides(1).Shapes("Opening Theme")
If i = 1 Then
'Do nothing
ElseIf i <> 1 Then
inc = 0.05
For bkgVol = 1 To 0.1
With bkgMusic.MediaFormat
.Volume = bkgVol
.Muted = False
End With
bkgVol = bkgVol - inc
Application.Wait (Now + TimeValue("0:00:01"))
Next bkgVol
End If
End Sub

Answer 1

This almost works, but PPT shoots us down in the end. After it runs, the volume of the sound file has been reduced, but it doesn't change during the slideshow.
Sub OnSlideShowPageChange()
Dim i As Integer
Dim bkgMusic As Shape
' This needs to be single, not Long
Dim bkgVol As Single
Dim inc As Long
Dim lCounter As Long
i = ActivePresentation.SlideShowWindow.View.CurrentShowPosition
Set bkgMusic = ActivePresentation.Slides(1).Shapes("Opening Theme")
If i = 2 Then
inc = 0.05
' Changing the value by fractions so must be a single, not a long, and
' decreasing the value requires Step and a negative number:
For bkgVol = 1 To 0.1 Step -0.1
With bkgMusic.MediaFormat
.Volume = bkgVol
.Muted = False
End With
'bkgVol = bkgVol - inc
' Application.Wait is not supported in PPT
'Application.Wait (Now + TimeValue("0:00:01"))
WaitForIt
SlideShowWindows(1).View.GotoSlide (2)
Next bkgVol
End If
End Sub
Sub WaitForIt()
Dim x As Long
For x = 1 To 1000000
DoEvents
Next
'MsgBox "Done waiting"
End Sub