How too copy and resize muliple pictures in VBA? (1 Viewer)

[Maazter]

Hi Everyone,

In this thread I am searching of ways to copy files from a camera, to a new location using the dialog window and then resizing them before they reach there new destination.

The selecting and copying them works fine, but I cannot find a way of resizing them in... or after the copying process.

Any code or help would be greatly appreciated.


Thanks in advance.

 

[Galaxiom]

Run ImageMagick via commandline under the Shell command.

 

[Maazter]

Hi Galaxiom

Yes I was just looking at this going to give it a try now Thnx.

 

[Maazter]

Hi again,

I have been trying to resize with image magic.

I have added ImageMagickObject.dll as ref in vba and have found and edited the following code for use in my project.

So far there are no errors, but also nothing happens.....

Private Sub TstMoveRsz_Click()
On Error Resume Next

Dim img  'ImageMagick object
Dim inputdir 'original directory
Dim inputfld ' file collection in the original folder
Dim outputdir 'destination directory
Dim Destnfld 'file collection in the destination folder
Dim fso 'filesystem object
Dim f 'file object
Dim MinSize 'scale size
Dim MaxSize 'largest file size to be resized
Dim rs

inputdir = "C:\DB_Data\Data\mark\Photos\Test\"
outputdir = "C:\DB_Data\Data\mark\Photos\Test\Moved\"

'define how big the thumbnail should be
MinSize = "50%" 'default to reduce 1/4 size of original, it can be changed
MaxSize = 10 '100000000 ' default only file larger than 100 Mega need to be resized

Set img = CreateObject("ImageMagickObject.MagickImage.1") 'Create a ImageMagick Object
Set fso = CreateObject("Scripting.FileSystemObject") 'Create a File System Object
Set inputfld = fso.GetFolder(inputdir).Files 'Get all files in the original folder
Set Destnfld = fso.GetFolder(outputdir).Files 'Get all files in the destination folder

'-resize width{%}{@} {!} {<} {>}
'resize an image.


For Each f In inputfld
'if and only if there is no "resized" image in the destination folder (avoid redudant work) and the original file size is larger than nFileSize
If Not fso.FileExists(outputdir & fso.GetBaseName(f) & "_resize." & fso.GetExtensionName(f)) And f.Size > MaxSize Then
' Use ImageMagick's Convert function to resize and add "_resize" at the end of original file name
rs = img.Convert("-quiet", "-resize", MinSize, inputfld & f.Name, Destnfld & fso.GetBaseName(f) & "_resize." & fso.GetExtensionName(f))

End If
Next

Set img = Nothing
End Sub

 

[Maazter]

No luck with imagemagick at the moment,

Keep on getting error 429 ActiveX component cannot create object.

Anyone got any ideas or does someone have experience using imagemagick?

Thnx

 

[Galaxiom]

I had not thought of running ImageMagick like that.

Try running it from the commandline. The Shell command in VBA can run a command.

 

[Maazter]

Hi Galaxiom,

Can you give me an example to work on m8?

Still a bit of a newbie with code, If i can see it then i can work with it, but as far as off the top of my head, a bit layman

Btw, I have tried various ways of running the vba, "shall we say different approaches" they all come up with the same error, after having this error I have found that there are a few dependencies in the ImageMagickObject.dll that are not found...

GPVSC.dll and IESHIMS.dll.

These... if I'm not mistaken are causing the object failure. Looking into it





Thnx.

Mark.

 

[Maazter]

Solved thank you all anyway.

 

[jdraw]

Mark,
Glad you have it resolved.
You want to elaborate on what you did to solve the issue?
No doubt, others will come searching for a solution at some time.

 

[Maazter]

Yea sure nps,

Firstly I didn't manage in the time frame i had... to resolve the issue with vba and imageMagic.

What I did is to use VBA to create a a bat file with the correct procedure to call the functions in ImageMagic, then call the *.bat file to Resize the images in the folder.

The following code is to create the bat file, and then call it.

If you need the functions behind the variables as well, Then I will gladly post them.

Public Function CreateText(ClientFld As String, ClientFld2 As String, tWidth As Integer, tHight As Integer)

Dim ImgScript As TextStream
Dim fso As Variant
Dim batPath As String: batPath = "C:\DB_Data\Data\"
Dim rSize As String
Dim paSSrKey As String

Set fso = CreateObject("Scripting.FileSystemObject")
Set ImgScript = fso.CreateTextFile("C:\DB_Data\Data\Images.bat", True)

Const Q As String * 1 = """"

ClientFld = Q & ClientFld & "%%i"""
rSize = tWidth & "x" & tHight

Call GetRegKeyImgMagic(paSSrKey)


ImgScript.WriteLine "@ECHO OFF"
ImgScript.WriteLine ""
ImgScript.WriteLine "set resizeSize=" & rSize
ImgScript.WriteLine "set convert_exe=" & Q & paSSrKey & Q
ImgScript.WriteLine "set foldername=" & Q & ClientFld2 & Q
ImgScript.WriteLine ""
ImgScript.WriteLine ""
ImgScript.WriteLine "IF NOT EXIST ""%convert_exe%"" ("
ImgScript.WriteLine "  echo ImageMagick path is incorrect. You need to set it up in batch file!"
ImgScript.WriteLine "  echo Current value: %convert_exe%"
ImgScript.WriteLine "  pause"
ImgScript.WriteLine "  exit 4"
ImgScript.WriteLine " )"
ImgScript.WriteLine ""
ImgScript.WriteLine "echo Resizing JPG files in %foldername%:"
ImgScript.WriteLine ""
ImgScript.WriteLine "chdir /D %foldername%"
ImgScript.WriteLine "set tmpCnt=0"
ImgScript.WriteLine "for /F ""usebackq delims="" %%i in (`dir /a:-d /b %foldername%\*.jpg`) do ("
ImgScript.WriteLine "  set /a tmpCnt+=1"
ImgScript.WriteLine "  call echo Proceed file %%tmpCnt%% from %%dirCnt%%: ""%%i"""
ImgScript.WriteLine ""
ImgScript.WriteLine """%convert_exe%"" ""%%i"" -resize %resizeSize%  -quality 95" & " " & ClientFld
ImgScript.WriteLine " )"
ImgScript.WriteLine ""
ImgScript.WriteLine "echo """""
ImgScript.WriteLine "echo Resizing is done, check folder web for results!"
ImgScript.WriteLine "echo """""
ImgScript.WriteLine "EXIT"


Call shell(Environ$("COMSPEC") & " /c " & batPath & "\Images.bat", vbNormalFocus)

End Function