如何從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