提取PPT中swf,并用独立flash播放器打开（解决目前flash失效问题）

一、利用excel提取ppt中的swf

1、新建excel,注意是xls格式的，“查看代码”中输入以下代码

Sub ExtractFlash()

Dim tmpFileName As String, FileNumber As Integer

Dim myFileId As Long 

Dim myArr() As Byte 

Dim i As Long

Dim MyFileLen As Long, myIndex As Long

Dim swfFileLen As Long 

Dim swfArr() As Byte 

tmpFileName = Application.GetOpenFilename("office File(*.doc;*.xls),*.doc;*.xls", , "确定要分析的 Office 档")

 If tmpFileName = "False" Then Exit Sub 

myFileId = FreeFile

Open tmpFileName For Binary As #myFileId

MyFileLen = LOF(myFileId)

ReDim myArr(MyFileLen - 1)

Get myFileId, , myArr()

Close myFileId

Application.ScreenUpdating = False

i = 0

Do While i < MyFileLen

  If myArr(i) = &H46 Then

      If myArr(i + 1) = &H57 And myArr(i + 2) = &H53 Then

      swfFileLen = CLng(&H1000000) * myArr(i + 7) + CLng(&H10000) * myArr(i + 6)+CLng(&H100) * myArr(i + 5) + myArr(i + 4)

      ReDim swfArr(swfFileLen - 1)

      For myIndex = 0 To swfFileLen - 1

           swfArr(myIndex) = myArr(i + myIndex)

     Next myIndex

     Exit Do

   Else 

       i = i + 3

   End If 

   Else

       i = i + 1

   End If

Loop

myFileId = FreeFile

tmpFileName = Left(tmpFileName, Len(tmpFileName) - 4) & ".swf"

Open tmpFileName For Binary As #myFileId

Put #myFileId, , swfArr

Close myFileId

MsgBox "以" & tmpFileName & "名字保存"

End Sub

2、将ppt中的swf直接复制到一个新建的excel（不是刚才那个）

3、使用已有代码的excel，运行宏，会弹出选择excel文件的界面，就选中刚才粘贴了swf的excel，然后就可以在原路径找到swf文件了

4、使用独立flash文件播放器（不用安装，绿色便携）就可以播放swf了

https://jingyan.baidu.com/article/4b52d7028ee6cffc5d774b7e.html

https://www.flash.cn/support/debug-downloads

(页面底部可以下载独立的flash播放器)