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.

       

       

       

      ----------------

      resize.vbs

      ----------------

       

      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

      Next

       

       

      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

          Next

       

       

          Dim appRef

          If found Then

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

          Else

              Set appRef = CreateObject("Photoshop.Application")

          End If

       

       

          Do While appRef.documents.Count

             appRef.activeDocument.Close 2 'dont' save

          Loop

       

       

          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"

        else

               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

      -------------------------------------