كود دالة لإستخراج ملفات الفلاش من ملفات الإكسيل

بسم الله الرحمن الرحيم

السلام عليكم ورحمة الله وبركاته

إستلمت ملفات إكسيل كثيرة وتحتوي على ملفات فلاش .. وحاولت جاهدا أن أستخرجها .. ولكن معلوماتي في الإكسيل لم تسعفني .. فبحثت في النت عن طريقة الإستخراج .. لقناعتي ما دام الإكسيل قادر على إدراجها فهو قادر على إستخراجها .. وباء بحثي بالفشل

ولكن وصدفة وقعت على منتدى أجنبي .. يظهر كود مبرمج بالـ VBA لإستخراج ملفات الفلاش من ملفات الإكسيل والوورد ..وكتب صاحب الموضوع التالي:

Here a code found in China Excel forum to extract embedded Flash file in Excel / Word.

Sub ExtractFlash() 
	Dim tmpFileName As String, FileNumber As Integer 
	Dim myFileId As Long 
	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", , "Select Excel / Word 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 "SaveAs " & tmpFileName 
End Sub

ولا أخفيكم أني حاولت أن أحلل الكود لأفهمه ولم أستطع .. فلعل أهل الخبرة يساعدوننا في فهمه .. ولكن حين التطبيق أعطاني خطأ في سطرين.. الأول

tmpFileName = Application.GetOpenFilename("office File(*.doc;*.xls),*.doc;*.xls", , "Select Excel / Word File")

وهذا واضح لأن الكود يبحث عن موديول "مربع فتح الملفات" بهذا الإسم وعوضته بإستدعاء موديول آخر .. والسطر الثاني

Application.ScreenUpdating = False

فلم أعرف ماذا أفعل فقمت بتعطيل الكود (بجعل لونه أخضر) .. والحمدلله يعمل الكود بعد التعطيل من دون مشاكل

وبحكم إهتمامي فقط بالإكسيل فلقد عملت المثال المرفق وعدلت فيه بما يناسبني وأضفت موديول مربع فتح الملفات من أحد أمثلة المنتدى(جزى الله صاحبه خيرا) .. وعليه فتقريبا كل المثال لم أبرمجه أنا ولكن تلاعبت فيه ليحقق مرادي .. وفي الملف المرفق البرنامج مضافا إليه ملف إكسيل يحتوي على ملف فلاش لتطبقوا عليه .. وأحببت أن أضعه بين أيديكم .. عرفانا بجميل هذا المنتدى الذي له بعد الله الفضل .. بفهمي لهذه اللغة السهلة الجميلة

ولا تنسونا من صالح دعاؤكم

FlashExtracorFromExcelFile.zip