0 Replies Latest reply on Jun 29, 2016 9:35 AM by İhsan Gerçelman

    It can not CreateObject("Photoshop.Application")" in Photoshop CC 2015.5

    İhsan Gerçelman

      My VBS script does not work with Photoshop 2015.5.


      I was use it by years with lots of Photoshop versions.


      Last week I updated myy Photoshop to 2015.5 than scripts does not work.


      My OS is Windows 10 64 bit.


      My sample script is below.


      It gives error on tle line "Set appRef = CreateObject("Photoshop.Application")"


      And it can not create object. Error code is 800A01AD


      How can I solve the problem?


      Thanking you in advance.








      Public Const RESIZEWIDTH = 800

      Public Const RESIZEHEIGHT = 800



      Public Const IGNOREVERTICAL = false

      Public Const SAVE_TH = false

      Public Const SUFFIX = "_"



      Dim spath

      spath = Mid(WScript.ScriptFullName, 1, InStrRev(WScript.ScriptFullName, "\", -1, vbBinaryCompare))



      Dim fso

      Set fso = CreateObject("Scripting.FileSystemObject")



      Dim foldero

      Set foldero = fso.GetFolder(spath)



      Dim fileo

      Dim sfile



      For Each fileo In foldero.Files

          'only modify jpg files

          sfile = fileo.Name

          If InStrRev(sfile, ".jpg", -1, vbTextCompare) = Len(sfile) - 3 Then

              resize spath & sfile

          End If




      MsgBox "Complete."



      Sub resize(sfilename)



          Set WshShell = WScript.CreateObject("WScript.Shell")

          Set colProcessList = GetObject("Winmgmts:").ExecQuery("Select * from Win32_Process")



          Dim found

          found = False



          For Each objProcess In colProcessList

              If StrComp(objProcess.Name, "photoshop.exe", vbTextCompare) = 0 Then

                  found = True

                  Exit For

              End If




          Dim appRef

          If found Then

              Set appRef = GetObject(, "Photoshop.Application")


              Set appRef = CreateObject("Photoshop.Application")

          End If



          Do While appRef.documents.Count

             appRef.activeDocument.Close 2 'dont' save




          Dim originalRulerUnits

          originalRulerUnits = appRef.Preferences.RulerUnits

          appRef.Preferences.RulerUnits = 1 'pixels



          Dim docRef

          Set docRef = appRef.Open(sfilename)



          Dim modified

          modified = False



          If docRef.Width >= docRef.Height Then 'horizontal photo

        If docRef.Width <> RESIZEWIDTH  Then

        If docRef.Width > RESIZEWIDTH or docRef.Width < 480 Then

        docRef.ResizeImage RESIZEWIDTH 'preserves aspect ratio

        modified = True

        End If

                  End If

          Else 'verticle photo

              If Not IGNOREVERTICAL Then 'proceed

                  If docRef.Height <> RESIZEHEIGHT Then

        If docRef.Height > RESIZEHEIGHT or docRef.Height < 480 Then

        docRef.ResizeImage , RESIZEHEIGHT 'preserves aspect ratio

        modified = True

        End If

                  End If

              End If

          End If



          If modified Then 'only save if the image was modified

              Dim jpgSaveOptions

              Set jpgSaveOptions = CreateObject("Photoshop.JPEGSaveOptions")

              jpgSaveOptions.Quality = 8



              'calculate the new file name

              Dim newfilename

        if SAVE_TH then

               newfilename = Mid(sfilename, 1, Len(sfilename) - 4) & SUFFIX & ".jpg"


               newfilename = sfilename

        end if

              docRef.SaveAs newfilename, jpgSaveOptions, True, 2 'for psLowercase

          End If



          docRef.Close 2 'dont' save



          appRef.Preferences.RulerUnits = originalRulerUnits



      End Sub