MS Access VBA - RealWorld forums

I'm trying to get this to work in VBA to downsize the original photo by 75% to link and display in Access, but to keep the original size in another folder for purposes of viewing in picture manager. My code is:

Public Function ResizePhoto()

Dim RetVal
Dim strDest As String
Dim strFileName As String
Dim strApp As String

strFileName = Me.fldPicturePath
strDest = CurrentProject.path & "\Auction_Pictures\3\Small\"
strApp = CurrentProject.path & "\PhotoResize400.exe -o -q100 " & strDest & " " & strFileName

RetVal = Shell(strApp)

End Function

This isn't working at all. Any ideas?

Yes, the destination is not given as folder, but using a -c parameter and a template. Also, enclose paths with spaces in double quotes. There are some VB usage examples in the older comments section on the tool's page.

Thank you. I may be missing something here, but I can't seem to find a tool's page.

picture-resize

I don't know. I'm still not getting this. It seems to work, or at least isn't throwing any errors, but isn't creating a file.

Here is a command that worked fro someone:

Shell("c:\programs\PhotoResize400.exe -q100 -o """ & strFullPath & """")

Use the double quotes.

Okay, after your help, some cursing and hair pulling, I finally got it to work.

Just for future users...

Public Function Resize Photo()

On Error GoTo ERRORHANDLER

Dim RetVal
Dim strDest As String
Dim strSource As String

strDest = "-c" & CurrentProject.path & "\Auction_Pictures\3\Small\SMALL_1.JPG"

strSource = Me.fldPicturePath

RetVal = Shell(CurrentProject.path & "\PhotoResize400.exe -n -q100 -o """ & strDest & """ """ & strSource & """", vbHide)

Exit Function

ERRORHANDLER:

MsgBox Err.Number & vbCrLf & vbCrLf & Err.Description

End Function

Thanks, this is going to help a lot

Hi Jimbo,

I did some hair pulling on the same thing and came up with some similar code. Here is the code for anyone who needs it. You should add some error handling code as in Jimbos example.

Public Sub MakeThumbs(ImageFolder As Variant)

   'This code calls PhotoResizer from ms-access 2000-2007
   'It makes thumbnails for a directory of images in a subdirectory called 'Thumbs'

   'File management variables
   Dim fs As Object, ThumbnailFolder As String

   'Variables for calling PhotoResizer
   Dim CmdLine As String, Result As String, StrQuote As String
   StrQuote = Chr$(34) 'Character 34 is a "

   'Make sure that the function receives a folder name
   If IsNull(ImageFolder) Then
       MsgBox "An image folder name needs to be supplied"
       Exit Sub
   End If

   'Check that the folder name is valid
   Set fs = CreateObject("Scripting.FileSystemObject")
   If Not fs.folderexists(ImageFolder) Then
       MsgBox "Source image folder name is not valid"
       Exit Sub
   End If

   'Check if the thumbnail folder is present and create it if it is not
   If Right(ImageFolder, 1) = "\" Then     'Checks whether folder name already includes a backslash before tacking on 'Thumbs'
       ThumbnailFolder = ImageFolder & "Thumbs\"
   Else
       ThumbnailFolder = ImageFolder & "\Thumbs\"
   End If

   If Not fs.folderexists(ThumbnailFolder) Then
       fs.createfolder (ThumbnailFolder)
   End If

   'Create the command line string that runs PhotoResizer
   'If you put the command line string directly in the shell function,
   'you can't recover the command line string to see what was actually passed.
   'This way you can, which aids in debugging.

   CmdLine = "J:\Temp\PhotoResizer\PhotoResize_360.exe " & StrQuote _
   & "-c" & ThumbnailFolder & "<NAME>.jpg" & StrQuote & " -Q75 -o " & StrQuote & ImageFolder & StrQuote

   '-c is the switch which redirects thumbnails to be sent to another directory, the name of the directory follows the switch
   '<NAME> is a variable which gets the name of the original image file and uses it for naming the thumbnail - you can add letters before or after if you like
   '-Q75 is the quality level
   '-o is switch which closes the PhotoResizer window automatically on completion.

'Sends a copy of CmdLine to the immediate window, so that you can inspect it if the process does not work properly
   Debug.Print CmdLine

   'Call PhotoResizer
   Result = Shell(CmdLine, vbMaximizedFocus)

   'The Result is not used, but as Shell() is a function, it has to pass a result back to a variable.

End Sub