Sub CollectFlashFromExcel()''' http://huikon.cn''Dim tmpFileName As String, FileNumber As IntegerDim myFileId As LongDim myArr() As ByteDim i As LongDim MyFileLen As Long, myIndex As LongDim swfFileLen As LongDim swfArr() As BytetmpFileName = Application.GetOpenFilename("office File(*.doc;*.xls),*.doc;*.xls", , "请选择一个包含Flash的Office文档") If tmpFileName = "False" Then Exit SubmyFileId = FreeFileOpen tmpFileName For Binary As #myFileIdMyFileLen = LOF(myFileId)ReDim myArr(MyFileLen - 1)Get myFileId, , myArr()Close myFileIdApplication.ScreenUpdating = Falsei = 0Do While i < MyFileLenIf myArr(i) = &H46 ThenIf myArr(i + 1) = &H57 And myArr(i + 2) = &H53 ThenswfFileLen = CLng(&H1000000) * myArr(i + 7) + CLng(&H10000) * myArr(i + 6) + CLng(&H100) * myArr(i + 5) + m ReDim swfArr(swfFileLen - 1)For myIndex = 0 To swfFileLen - 1swfArr(myIndex) = myArr(i + myIndex)Next myIndexExit DoElsei = i + 3End If

提取execl中的flash文件