Open files using *wildcard within photoshop

[Jill]

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

[Jill]

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

[Jill]

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