Turning an image from the filesystem into a thumbnail VBA

here is what you need: http://www.base64.co.uk/screen-capture-thumbnail-creation/ 

Can you help me integrate this code into my code for scaling down the image I get into a thumbnail image?

I guess I dont know how to add the freeimage dll to my access macro project. Can you give some detailed steps on how to do this?

Isnt there any quick code I can add my my existing code to scale down the image file into a thumbnail without using and outside dll? Either way please help! :(

You're not going to find an easier method for resizing and saving images than the FreeImage library, and it's not really that difficult to use.

1. Download the library (which comes with a VB wrapper) from Sourceforge:
http://freeimage.sourceforge.net/download.html

2. Put a copy of the FreeImage.dll in the same folder as your application

3. Add the MFreeImage.bas module to your project.

4. Place an image control named 'imgPic' on your form with its 'Stretch' Property set to true and sized to suit the size you want the saved thumbnail to be (NOTE: It doesn't have to be visible for this to work).

5. Adapt the code below to your requirements.

The code assumes the file type will always be BMP, if you need to handle file types other than bitmap you will have to add code to examine the file extensions and change the FIF types in lines 5 & 9 to suit--FIF_JPEG or FIF_GIF for example. You can of course always save the file as a Jpeg, no matter what its original type was, that way you'll keep disk usage to a minimum.

Dim lPicID As Long
Dim iScaleFactor as Integer
Dim bSaveOk As Boolean
    imgPic.Picture = LoadPicture(strBigImage)
    lPicID = FreeImage_Load(FIF_BMP, strBigImage)
    'Resize the image and save it'
    iScaleFactor = Screen.TwipsPerPixelX '12 on 120 dpi machine; 15 on 96 dpi machines'
    lPicID = FreeImage_Rescale(lPicID, imgPic.Width / iScaleFactor, imgPic.Height / iScaleFactor, FILTER_BOX)
    bSaveOk = FreeImage_Save(FIF_BMP, lPicID, strThumbPath) 'Save it'
    FreeImage_Unload (lPicID) 'Clean up'
    If bSaveOk Then MsgBox "The Thumbnail was successfully saved to: " & vbcr & strThumbPath

Select allOpen in new window

My apologies npl77, I thought I'd seen a VB6 tag in your original question and didn't realise it was for Access VBA. Not to worry though, the method will still work without an image control--that was really just a useful way to see what the thumbnail would look like anyway. The main difference is that you'll have to specify the size of the thumbnail in pixels and temporarily set the current directory to the location of the FreeImage DLL. The code below assumes it's in the same folder as the Access database.

Dim lPicID As Long
Dim bSaveOk As Boolean
Dim sCurDIR As String
Const iWidth As Integer = 100
Const iHeight As Integer = 100
    sCurDIR = CurDir
    ChDir CurrentProject.path
    lPicID = FreeImage_Load(FIF_BMP, strBigImage)
    'Resize the image and save it'
    lPicID = FreeImage_Rescale(lPicID, iWidth, iHeight, FILTER_BOX)
    bSaveOk = FreeImage_Save(FIF_JPEG, lPicID, strThumbPath) 'Save it'
    FreeImage_Unload (lPicID) 'Clean up'
    If bSaveOk Then MsgBox "The Thumbnail was successfully saved to: " & vbCr & strThumbPath
    ChDir sCurDIR

Select allOpen in new window

Can you show me the added code I need to accept BMP or JPEG and save the thumbnails as just JPEG. Thanks for all your help, Ill try and put this together when I get to work first thing Monday morning.

The problem with the dll approah is my manager is might not like the fact that I am going to have the package a dll with the client mdb file. So if there was any other way I could resize the images just in my macro that solution would suite me better, but if there isnt then if you could just help me with the added code above I would really appreciate it. Thanks alot for all the help you have given me on this.

One more thing. How do you do this in detail? I am very new too macro coding.....

3. Add the MFreeImage.bas module to your project.

<<You just need to change line 8 below>>

Clearly, that should have been line 7. I must learn to count properly! :-D

Line 19:

Is saving the new thumbnail to the filesystem, can I skip that step and save it directly to my db somehow. I am successfully saving images to my db with my code in the initial message. Otherwise maybe I will have to save the thumbnail to the users filesystem, save it with my code, then delete it from the users filesystem.

 

Great work, very helpful!

<<can I skip that step and save it directly to my db somehow>>

I dare say you can but I'm afraid I don't know enough about the ADO Stream to tell you how. But I'm kind of thinking 'why bother?' The file will be quite small and, as you say, you can delete it as soon as you've streamed it into the database. If you're concerned that the file might be left on the disk, I would suggest always saving it to the exact same obscure name (something like "~tmpTN" and no extension) and in a location where it wouldn't necessarily be considered a problem (like Windows\Temp).

I am getting a syntax error when calling this function I created below:

I dont think I know how to specify a thumbnail path (say I want to save the thumnail to windows/temp as tmpImage.jpg). How do I do that?

This is my button click so far..

Private Sub cmbCreateThumbnail_Click()
createthumbnail(txtpath.Value, ...(dont know how to specify the strThumbPath here keep getting a syntax error))

End Sub

Public Sub CreateThumbnail(ByVal strBigImage As String, ByVal strThumbPath As String)
Dim lPicID As Long
Dim bSaveOk As Boolean
Dim sCurDIR As String
Const iWidth As Integer = 100
Const iHeight As Integer = 100
    sCurDIR = CurDir
    ChDir CurrentProject.Path
    'Determine what kind of picture it is from its extension'
    Select Case Right(LCase(strBigImage), 4)
        Case ".bmp"
            lPicID = FreeImage_Load(FIF_BMP, strBigImage)
        Case ".gif"
            lPicID = FreeImage_Load(FIF_GIF, strBigImage)
        Case ".jpg", "jpeg"
            lPicID = FreeImage_Load(FIF_JPEG, strBigImage)
    End Select
    'Resize the image and save it as a compressed JPEG'
    lPicID = FreeImage_Rescale(lPicID, iWidth, iHeight, FILTER_BOX)
    bSaveOk = FreeImage_Save(FIF_JPEG, lPicID, strThumbPath) 'Save it'
    FreeImage_Unload (lPicID) 'Clean up'
    If bSaveOk Then MsgBox "The Thumbnail was successfully saved to: " & vbCr & strThumbPath
    ChDir sCurDIR
End Sub

Select allOpen in new window

<<I dont think I know how to specify a thumbnail path (say I want to save the thumnail to windows/temp as tmpImage.jpg). How do I do that?>>

I only really suggested Windows\Temp as one possibility but, thinking about it, that's not necessarily the best place to put it as that location can vary from system to system. There are API techniques for determining that path but since this is just a temporary file it doesn't really matter too much where it goes, as long as you can be sure that the user will have read/write privileges. With that in mind, I would suggest the user's temporary folder as the best place, which is readily obtained using the Environ function. Try calling the routine with something like this:

    CreateThumbnail txtPath.Text, Environ("Temp") & "\tmpImage.jpg"