Office文件中的Flash存成獨立檔案

出自NoahWiki

跳轉到: 導航, 搜尋

Flash崁入Office文檔後，要截取出成獨立.swf檔是費事一件，透過下列函式可以快速的達到目的。

先打開一個office軟體(如Word、Excel)，然後按「alt+f11」開始VBA編輯器後，新增(插入)一個模組，模組名稱不重要，將下列程式碼給貼到模組裡，再按 F5 執行，執行後會跳出開啟檔案的訊息，此時開啟一個含flash的Office文檔，就可以將 flash 給截取出來。 

Sub ExtractFlash()
Dim flashFileName As String, FileNumber As Integer
Dim fileId As Long
Dim tmpArr() As Byte
Dim i As Long
Dim fileLen As Long, myIndex As Long
Dim swfFileLen As Long
Dim swfArr() As Byte
 
flashFileName = Application.GetOpenFilename("office File(*.doc;*.xls),*.doc;*.xls", , "確定要分析的 Office 檔")
 
If flashFileName = "False" Then Exit Sub
fileId = FreeFile
Open flashFileName For Binary As #fileId
fileLen = LOF(fileId)
ReDim tmpArr(fileLen - 1)
Get fileId, , tmpArr()
Close fileId
Application.ScreenUpdating = False
i = 0
Do While i < fileLen
    If tmpArr(i) = &H46 Then
        If tmpArr(i + 1) = &H57 And tmpArr(i + 2) = &H53 Then
            swfFileLen = CLng(&H1000000) * tmpArr(i + 7) + CLng(&H10000) * tmpArr(i + 6) + CLng(&H100) * tmpArr(i + 5) + tmpArr(i + 4)
            ReDim swfArr(swfFileLen - 1)
            For myIndex = 0 To swfFileLen - 1
                swfArr(myIndex) = tmpArr(i + myIndex)
            Next myIndex
            Exit Do
        Else
            i = i + 3
        End If
    Else
        i = i + 1
    End If
Loop
 
fileId = FreeFile
flashFileName = Left(flashFileName, Len(flashFileName) - 4) & ".swf"
Open flashFileName For Binary As #fileId
Put #fileId, , swfArr
Close fileId
 
MsgBox flashFileName & "   另存完成!!"
 
End Sub

Excel操作參考圖:

Image:Officeextractflash.jpg



PS: 本文參考來源: http://club.excelhome.net/dispbbs.asp?boardID=2&ID=237225&page=1&px=0

取自"http://wiki.db.idv.tw/index.php/Office%E6%96%87%E4%BB%B6%E4%B8%AD%E7%9A%84Flash%E5%AD%98%E6%88%90%E7%8D%A8%E7%AB%8B%E6%AA%94%E6%A1%88"
工具箱