Hi all, happy new year!

I've been attempting to tackle this for a while now but as my VBA skills are basic to say the least I'd really appreciate it if someone would be kind enough to give me a few pointers.

As the title says, I'd like to reduce the file size of a number of image files (jpg) in a folder, and then save them as new files. To do this manually I normally use MS Paint, and so this has been my approach with VBA also. Here's the code that I have so far, shown for one file only (as the loop should be pretty simple);

Sub ResizePics()
 Dim ProgId, PaintLocation, FileLocation, FileNom, SaveLocation
 
 PaintLocation = "C:\Windows\system32\mspaint.exe"
 FileLocation = "C:\Users\UserX\Desktop\Large_pics\"
 SaveLocation = "C:\Users\UserX\Desktop\small_file_size\"
 FileNom = "IMG_0756.JPG"

 ProgId = Shell(PaintLocation & " " & FileLocation & FileNom, 1) 'open the file in MS Paint 
 Wait                                 'wait for the program to open successfully
 AppActivate ProgId            'activate the Paint window 

 Application.SendKeys ("^w")          ' open the resize window in MS Paint
 Application.SendKeys ("{TAB}")      ' Tab down to the horizontal percentage dialogue box
 Application.SendKeys ("20")           ' specify 20% reduction (arbitrary value); aspect ratio locked by default
 Application.SendKeys ("~")            ' enter to accept 
 Application.SendKeys ("{F12}")      ' open the SaveAs dialogue window

' Need help with the following...
' Application.SendKeys ("small_" & FileNom) ' specify the new file name *would like to also specify the SaveLocation*
' Application.SendKeys ("~")                     ' enter to accept the save with file name and location
' Application.SendKeys ("%FX")                 ' close MS Paint

End Sub
However, I can't figure out how to specify the save location in the SaveAs window using SendKeys (the last three commented SendKeys lines above). Any help with this, or any recommendation for a simpler method than using SendKeys, would be very much appreciated.

The wait function in the above code is necessary before AppActivate will work properly. The code was written by Russel Judge and found at http://vbcity.com/forums/t/81315.aspx ...

Sub Wait()
Dim WaitDt As Date
WaitDt = DateAdd("s", 3, Now())
Do While Now < WaitDt
Loop
End Sub
Many thanks in advance,

Mott