如何从word、excel、ppt中提取flash文件？

此方法在xp、window7下具有效果。

假设你要提取的flash在ppt中：

1、新建一个word文档(后缀是.doc,而不是.docx)

2、将待提取的ppt中的flash文件复制到步骤1中所建的word文档中。建议一个flash文件一个文档。

3、新建一个excel文档，快捷键[ALT+f11]调用出【Microsoft Visual Basic for Application】窗口

4、按快捷键[F7],调用出【代码窗口】。粘贴如下代码

5、按快捷键【F5】,运行。

6、步骤5会弹出一个窗口，让你选择文件，那么你就可以选择步骤2中的那个word文档。

7、完成步骤6后，就将你要提取的flash文件弄出来了。

 

 

Sub ExtractFlash()

Dim tmpFileName As String
Dim FileNumber As Integer
Dim myFileId As Long
Dim MyFileLen As Long
Dim myIndex As Long
Dim swfFileLen As Long
Dim i As Long
Dim swfArr() As Byte
Dim myArr() As Byte

tmpFileName = Application.GetOpenFilename("MS Office File (*.doc;*.xls), *.doc;*.xls", , "Open MS Office file")

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 "Save the extracted SWF Flash as [ " & tmpFileName & " ]"

End Sub

转载于:https://www.cnblogs.com/leamiko/archive/2013/01/27/2879005.html