[求助]怎样把EXCEL中的Flash文件提取出来啊？

wswcp

QUOTE:

以下是引用chrisfang在2006-6-21 16:23:27的发言：

时钟集锦：

谢谢分享

冰弦曳指

用以下代码可以转出flash文件：

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
OldName = Left(tmpFileName, Len(tmpFileName) - 4)
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
            myFileId = FreeFile
            tmpFileName = OldName & i & ".swf"
            Open tmpFileName For Binary As #myFileId
            Put #myFileId, , swfArr
            Close myFileId
            i = i + swfFileLen + 8
        Else
            i = i + 3
        End If
    Else
        i = i + 1
    End If
Loop
MsgBox "以" & OldName & "1-n.swf 名字保存"
End Sub

bluesky_0

QUOTE:

以下是引用冰弦曳指在2008-8-6 9:58:44的发言：

用以下代码可以转出flash文件：

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
OldName = Left(tmpFileName, Len(tmpFileName) - 4)
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
            myFileId = FreeFile
            tmpFileName = OldName & i & ".swf"
            Open tmpFileName For Binary As #myFileId
            Put #myFileId, , swfArr
            Close myFileId
            i = i + swfFileLen + 8
        Else
            i = i + 3
        End If
    Else
        i = i + 1
    End If
Loop
MsgBox "以" & OldName & "1-n.swf 名字保存"
End Sub

非常感谢！可是找不到库阿！ 

[此贴子已经被作者于2008-8-8 12:27:08编辑过]

tclanmo

这招不错

谢谢了

ostrich

[fly]下不了了呀,附件！[/fly]

li2653

我也想知道

ljcxmx

我来的迟了啊，但我要感谢楼主，从这里我学到了不少，虽然我还是差的很很远！

MicrosoftEH

学会了
多谢版主

alwaysearlybird

1.        打开一个新的excel文档。
2.        单击 Tools > Macro > Visual Basic Editor. 你也可以按ALT +F11热键来打开VBA编辑器。
3.        在VBA编辑器中，单击面板左上方的View Code图标。
4.        将下面的VBA程序源代码拷贝粘贴到VBA编辑器中。
5.        按F5来执行源代码。
6.        出来一个Open File对话框，提示你选择嵌入了flash动画文件的excel 文档。
7.        选择了excel 文档之后很快会出来一个消息框，告诉你提取出来的flash动画文件保存在了哪里。


从excel 或word中提取动画文件的源代码如下：

1. Sub ExtractFlash()
   
2. 
   
3. Dim tmpFileName As String
   
4. Dim FileNumber As Integer
   
5. Dim myFileId As Long
   
6. Dim MyFileLen As Long
   
7. Dim myIndex As Long
   
8. Dim swfFileLen As Long
   
9. Dim i As Long
   
10. Dim swfArr() As Byte
    
11. Dim myArr() As Byte
    
12. 
    
13. tmpFileName = Application.GetOpenFilename("MS Office File (*.doc;*.xls), *.doc;*.xls", , "Open MS Office file")
    
14. 
    
15. If tmpFileName = "False" Then Exit Sub
    
16. 
    
17. myFileId = FreeFile
    
18. 
    
19. Open tmpFileName For Binary As #myFileId
    
20. 
    
21. MyFileLen = LOF(myFileId)
    
22. 
    
23. ReDim myArr(MyFileLen - 1)
    
24. 
    
25. Get myFileId, , myArr()
    
26. 
    
27. Close myFileId
    
28. 
    
29. Application.ScreenUpdating = False
    
30. 
    
31. i = 0
    
32. 
    
33. Do While i < MyFileLen
    
34. 
    
35.    If myArr(i) = &H46 Then
    
36. 
    
37.       If myArr(i + 1) = &H57 And myArr(i + 2) = &H53 Then
    
38. 
    
39.          swfFileLen = CLng(&H1000000) * myArr(i + 7) + CLng(&H10000) * myArr(i + 6) + CLng(&H100) * myArr(i + 5) + myArr(i + 4)
    
40. 
    
41.          ReDim swfArr(swfFileLen - 1)
    
42. 
    
43.          For myIndex = 0 To swfFileLen - 1
    
44.             swfArr(myIndex) = myArr(i + myIndex)
    
45.             Next myIndex
    
46.          Exit Do
    
47. 
    
48.       Else
    
49.             i = i + 3
    
50.       End If
    
51. 
    
52.    Else
    
53.         i = i + 1
    
54.    End If
    
55. 
    
56. Loop
    
57. 
    
58. myFileId = FreeFile
    
59. 
    
60. tmpFileName = Left(tmpFileName, Len(tmpFileName) - 4) & ".swf"
    
61. 
    
62. Open tmpFileName For Binary As #myFileId
    
63. 
    
64. Put #myFileId, , swfArr
    
65. 
    
66. Close myFileId
    
67. 
    
68. MsgBox "Save the extracted SWF Flash as [ " & tmpFileName & " ]"
    
69. 
    
70. End Sub
    

复制代码

hanzhang98

是啊,已经嵌入的swf文件如何提取出来??