Consulting

Results 1 to 3 of 3

Thread: Open files using *wildcard within photoshop

  1. #1
    VBAX Regular
    Joined
    Jun 2017
    Posts
    26
    Location

    Open files using *wildcard within photoshop

    Hi forum members.

    I'm hoping someone can shed light on what I'm doing wrong.

    I have a number of files within a folder. I want to open only the files that have the word "shadow" in their filename. I want to open these files in the photoshop application.

    The script works when referencing the exact path with filename, but I can't use the exact path because the filename is variable (however it always contains "shadow"). I left my attempts that failed commented out.

    Sub Main()
    
    
        LayerFiles "C:\Rendermation\Renders"
        
    End Sub
    
    
    Sub LayerFiles(strFolder)
    
        Dim ObjPhotoshop
        Dim fso, folder, files, folderIdx
        Dim arrFileType
        Dim arrCameraAngle
    
    
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set folder = fso.GetFolder(strFolder)
        Set files = folder.files
    
    
    
    Set ObjPhotoshop = CreateObject("Photoshop.Application")
       
    
    
    For Each folderIdx In files
    
    
         arrFileType = Split(folderIdx.Name, ".")
         If IsArray(arrFileType) Then
             If arrFileType(UBound(arrFileType)) = "png" Then
    
             ObjPhotoshop.Open "C:\Rendermation\Renders\bluestone_Flair_Channel_Cushion_R_3-4X3-4.3dm_Shadow.png"
           ' ObjPhotoshop.Open & Chr(34) & strFolder & folderidx.name & Chr(34)
           ' ObjPhotoshop.Open "& Chr(34) & strFolder & folderIdx.Name & Chr(34) & "
           ' ObjPhotoshop.Open "C:\Rendermation\Renders" & "*Shadow"
      
            End If
          End If
    
    Next
    
    End Sub
    
    Function FileExists(strFile)
        Dim objFSO
        Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    
        If objFSO.FileExists(strFile) Then
            FileExists = True
        Else
            FileExists = False
        End If
                    
        Set objFSO = Nothing
    End Function
    
    
    Function MkDir(strDirectory)
        Dim objFSO
        Dim objFolder
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        Set objFolder = objFSO.CreateFolder(strDirectory)
        Set objFolder = Nothing
        Set objFSO = Nothing
    End Function
    
    
    Function FolderExists(strFolder)
        Dim objFSO
        Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    
        If objFSO.FolderExists(strFolder) Then
            FolderExists = True
        Else
            FolderExists = False
        End If
                    
        Set objFSO = Nothing
    End Function

  2. #2
    VBAX Regular
    Joined
    Jun 2017
    Posts
    26
    Location
    Here is alternative attempt. It seems that I am using the wildcard incorrectly in both of my attempts.

    Sub Main()
    
    
        LayerFiles "C:\Rendermation\Renders\"
        
    End Sub
    
    
    Sub LayerFiles(strFolder)
    
    
    Dim ObjPhotoshop
        Dim fso, folder, files, folderIdx
        Dim arrFileType
        Dim arrCameraAngle
            
        Dim InputImagePath      As String
        Dim OutputImagePath     As String
        Dim OutputWidthInPixels As Integer
        Dim PsApp               As Photoshop.Application
        Dim PsDoc               As Photoshop.Document
        Dim PsSaveOptions       As Photoshop.PNGSaveOptions
    
    
    
    
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set folder = fso.GetFolder(strFolder)
        Set files = folder.files
    
    'InputImagePath = "C:\Rendermation\Renders\" & "*.png" 'THIS DOES NOT WORK BUT THE NEXT LINE DOES
    InputImagePath = "C:\Rendermation\Renders\bluestone_Flair_Channel_Cushion_R_3-4X3-4.3dm_Shadow.png"
    
    
    OutputImagePath = "C:\users\Jill\Desktop\Test\"
    
    
    If FileExists(InputImagePath) = False Then
            MsgBox "The path of the input image is invalid!", vbCritical, "Input Image Path Error"
            Exit Sub
        End If
        
        'Create a new instance of Photoshop application and make it visible.
        On Error Resume Next
        Set PsApp = New Photoshop.Application
        If PsApp Is Nothing Then
            MsgBox "Sorry, it was impossible to start Photoshop!", vbCritical, "Photoshop Application Error"
            Exit Sub
        End If
        PsApp.Visible = True
        
        
        'Try to open the input image.
        If FileExists(InputImagePath) And folderIdx.Name = "*Shadow" Then
        Set PsDoc = PsApp.Open(InputImagePath)
        If PsDoc Is Nothing Then
            MsgBox "Sorry, it was impossible to open the input image!", vbCritical, "Image Opening Error"
            Exit Sub
        End If
        On Error GoTo 0
        End If
    
    End Sub

  3. #3
    VBAX Regular
    Joined
    Jun 2017
    Posts
    26
    Location
    Still trying to figure this out. I've done a bit of research and it indicates that I can't use a wildcard when opening a file. However it indicates I can if I use DIR. So I attempted to do so and now I get past that line of the script. However I get a new error that says "Run-time error 91: Object variable or With block variable not set". (The line where the error occurs is indicated with a comment below.)

    Thanks in advance to anyone who can help.

    Sub Main()
    
    
        LayerFiles "C:\Rendermation\Renders"
        
    End Sub
    
    
    Sub LayerFiles(strFolder)
    
    Dim ObjPhotoshop
        Dim fso, folder, files, folderIdx
        Dim arrFileType
        Dim InputImagePath      As String
        Dim OutputImagePath     As String
        Dim OutputWidthInPixels As Integer
        Dim PsApp               As Photoshop.Application
        Dim PsDoc               As Photoshop.Document
        Dim PsSaveOptions       As Photoshop.PNGSaveOptions
        Dim strFile
    
    
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set folder = fso.GetFolder(strFolder)
        Set files = folder.files
    
    strFile = Dir(strFolder & "\" & "bluestone_*shadow*" & ".png", vbNormal)
    
    
    While strFile <> ""
    
    
    Set PsDoc = PsApp.Open(strFile)  'This is where the error occurs
        If ObjPhotoshop Is Nothing Then
        
        If PsDoc Is Nothing Then
            MsgBox "Sorry, it was impossible to open the input image!", vbCritical, "Image Opening Error"
            Exit Sub
        End If
        On Error GoTo 0
        End If
      
     Wend
    
    End Sub
              
        
                                                        
    Function FileExists(strFile)
        Dim objFSO
        Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    
        If objFSO.FileExists(strFile) Then
            FileExists = True
        Else
            FileExists = False
        End If
                    
        Set objFSO = Nothing
    End Function
    
    
    Function MkDir(strDirectory)
        Dim objFSO
        Dim objFolder
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        Set objFolder = objFSO.CreateFolder(strDirectory)
        Set objFolder = Nothing
        Set objFSO = Nothing
    End Function
    
    
    Function FolderExists(strFolder)
        Dim objFSO
        Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    
        If objFSO.FolderExists(strFolder) Then
            FolderExists = True
        Else
            FolderExists = False
        End If
                    
        Set objFSO = Nothing
    End Function

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •