最近得到一些好玩的Falsh,无奈都是嵌入在Word或Excel中的。几经搜寻,找到一个很好的提取方法。这样就可以直接带着Flash跑咯。。。
具体方法:
1. 随便找一个Excel文件(不可以是Word),打开。
2. 点击工具——>宏——>宏
3. 弹出一个宏创建窗体,在窗口中输入宏名(例如:宏名:ExtractFlash)点击创建按钮。注意,必须先输入“宏名”之后创建按钮才可以点哦。。。
4. 弹出一个编程界面,在界面的中间有一个小窗口,在窗口中输入下面的程序段。
<!--<br /><br />Code highlighting produced by Actipro CodeHighlighter (freeware)<br />http://www.CodeHighlighter.com/<br /><br />-->
SubCollectFlashFromExcel()
SubCollectFlashFromExcel()
'
'CollectFlashFromExcelMacro
'宏由phcis录制,时间:2008-9-4
'

'
DimtmpFileNameAsString,FileNumberAsInteger
DimmyFileIdAsLong
DimmyArr()AsByte
DimiAsLong
DimMyFileLenAsLong,myIndexAsLong
DimswfFileLenAsLong
DimswfArr()AsByte


tmpFileName=Application.GetOpenFilename("officeFile(*.doc;*.xls),*.doc;*.xls",,"请选择一个包含Flash的Office文档")


IftmpFileName="False"ThenExitSub

myFileId=FreeFile

OpentmpFileNameForBinaryAs#myFileId

MyFileLen=LOF(myFileId)

ReDimmyArr(MyFileLen-1)
GetmyFileId,,myArr()
ClosemyFileId

Application.ScreenUpdating=False

i=0

DoWhilei<MyFileLen

IfmyArr(i)=&H46Then

IfmyArr(i+1)=&H57AndmyArr(i+2)=&H53Then

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

ReDimswfArr(swfFileLen-1)

FormyIndex=0ToswfFileLen-1

swfArr(myIndex)=myArr(i+myIndex)

NextmyIndex
ExitDo
Else
i=i+3
EndIf
Else
i=i+1
EndIf
Loop



myFileId=FreeFile

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

OpentmpFileNameForBinaryAs#myFileId

Put#myFileId,,swfArr

ClosemyFileId


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

EndSub
SubCollectFlashFromExcel()
SubCollectFlashFromExcel()
'
'CollectFlashFromExcelMacro
'宏由phcis录制,时间:2008-9-4
'
'
DimtmpFileNameAsString,FileNumberAsInteger
DimmyFileIdAsLong
DimmyArr()AsByte
DimiAsLong
DimMyFileLenAsLong,myIndexAsLong
DimswfFileLenAsLong
DimswfArr()AsByte

tmpFileName=Application.GetOpenFilename("officeFile(*.doc;*.xls),*.doc;*.xls",,"请选择一个包含Flash的Office文档")

IftmpFileName="False"ThenExitSub
myFileId=FreeFile
OpentmpFileNameForBinaryAs#myFileId
MyFileLen=LOF(myFileId)
ReDimmyArr(MyFileLen-1)
GetmyFileId,,myArr()
ClosemyFileId
Application.ScreenUpdating=False
i=0
DoWhilei<MyFileLen
IfmyArr(i)=&H46Then
IfmyArr(i+1)=&H57AndmyArr(i+2)=&H53Then
swfFileLen=CLng(&H1000000)*myArr(i+7)+CLng(&H10000)*myArr(i+6)+CLng(&H100)*myArr(i+5)+myArr(i+4)
ReDimswfArr(swfFileLen-1)
FormyIndex=0ToswfFileLen-1
swfArr(myIndex)=myArr(i+myIndex)
NextmyIndex
ExitDo
Else
i=i+3
EndIf
Else
i=i+1
EndIf
Loop


myFileId=FreeFile
tmpFileName=Left(tmpFileName,Len(tmpFileName)-4)&".swf"
OpentmpFileNameForBinaryAs#myFileId
Put#myFileId,,swfArr
ClosemyFileId

MsgBox"以"&tmpFileName&"名字保存"
EndSub
等提取结束后将会在源文件同一路径下生成同名的swf文件,即Flash文件。
请注意:
1.如果出现语法错误,找不到Application.GetOpenFilename()请将它的下一行移动到上一行结尾即可。。。
2.如果要提取Word中的Flash请将宏建立在Excel中,然后运行的时候选择要提取的Word文件即可。直接建立在Word中将会提示找不到方法。
本文介绍了一种从Word和Excel文档中提取嵌入Flash文件的方法。通过在Excel中使用VBA宏,可以定位并保存Flash为独立的.swf文件。
3873

被折叠的 条评论
为什么被折叠?



