images from assembly and part files

Dear Users,

can i get a macro (.exe) file to extract images from assembly and part files and will save them in the respective folders where part or assembly exist.

 

please give me links if anybody have it.

or any guidance will be appreciated

 

Ravi

 

 

Posted by: Ravindra Borhade
Post date: 7/27/2011 6:32:12 PM

1 REPLY

RE: images from assembly and part files

Ravi,

 

the VB6 Code below extract StdPicture from SE-Files.

 

Private SETE As SeThumbnailExtractor

 

Private Type PICTDESC

cbSizeofStruct As Long

PicType As Long

hImage As Long

xExt As Long

yExt As Long

End Type

 

Private Type GUID

Part1 As Long

Part2 As Integer

Part3 As Integer

Part4 As Integer

Part5(1 To 6) As Byte

End Type

 

Private Declare Function OleCreatePictureIndirect Lib "Olepro32" _

(ByRef pPictDesc As PICTDESC, ByRef RIID As GUID, _

ByVal fOwn As Long, ByRef ppvObj As Any) As Long

Private Declare Function IIDFromString Lib "OLE32" _

(ByVal lpsz As String, ByRef lpiid As GUID) As Long

 

Public Function GetSEPicHandle(ByVal sFileName As String, _

ByRef iPic As StdPicture) As Boolean

 

Dim hBitMap As Long

On Error GoTo ErrorHandler

 

Set SETE = New SeThumbnailExtractor

SETE.GetThumbnail sFileName, hBitMap

Set iPic = PictureFromHandle(hBitMap, vbPicTypeBitmap, True)

Set SETE = Nothing

 

GetSEPicHandle = True

Exit Function

ErrorHandler:

Set SETE = Nothing

Err.Clear

End Function

 

Private Function PictureFromHandle(ByVal Handle As Long, _

ByVal PictureType As PictureTypeConstants, _

Optional ByVal PictureOwnsHandle As Boolean = False) _

As StdPicture

 

Dim nPicture As Picture

Dim nPictDesc As PICTDESC

Dim nIID As GUID

Dim nHResult As Long

 

Const kPictureIID = "{7BF80981-BF32-101A-8BBB-00AA00300CAB}"

 

On Error GoTo ErrorHandler

 

With nPictDesc

.cbSizeofStruct = Len(nPictDesc)

.PicType = PictureType

.hImage = Handle

End With

nHResult = IIDFromString(StrConv(kPictureIID, vbUnicode), nIID)

If nHResult Then

GoTo ErrorHandler

Else

nHResult = OleCreatePictureIndirect(nPictDesc, nIID, _

PictureOwnsHandle, nPicture)

If nHResult Then

GoTo ErrorHandler

Else

Set PictureFromHandle = nPicture

End If

End If

Set nPicture = Nothing

 

Exit Function

ErrorHandler:

Set nPicture = Nothing

Err.Clear

End Function

 

regards

Gerald

 

Posted by: Gerald Haberl
Post date: 7/27/2011 8:16:33 PM