Using a Macro to open the most recent picture in a folder

[felix040893]

Hi guys & girls,

I'm currently trying to create a Macro in Excel that opens the most recent picture (.jpg) out of a folder for me.
I'm not bad with Excel, but I've never worked with Macros. Using the most recent office version (March 2019).

I found the following code online:

Sub AktuellesDokument()


Dim varDirectory As Variant
Dim flag As Boolean
Dim i As Integer
Dim strDirectory As String


Dim thisFile As String
Dim currentFile As String
currentFile = 0
Dim currentFileAll As String


strDirectory = "C:\Users\fw\Desktop\Bilder Kamera"
i = 1
flag = True
varDirectory = Dir(strDirectory, vbDirectory)


While flag = True
If varDirectory = "" Then
flag = False
Else


If i > 2 Then
thisFile = Right(varDirectory, 15)
thisFile = Replace(thisFile, ".jpg", "")
thisFile = Replace(thisFile, "_", "") * 1
If thisFile > currentFile Then
currentFile = thisFile
currentFileAll = varDirectory
End If
End If
varDirectory = Dir
i = i + 1
End If
Wend


Workbooks.Open strDirectory & currentFileAll
End Sub

Unfortunately that doesn't work.. I'm getting an error message back '1004': That tells me that excel cant access the data in the Folder "Bilder Kamera".
The red line of code is where I seem to be getting problems. Maybe because I found the code online and only changed the path to the folder and changed the code from a ".xls" to a ".jpg" and now the workbooks.open part doesn't match with the .jpg as it's not a workbook ?!

Can any of you help me fix this code or come up with a better one?
Thanks so much in advance!
Best from Germany,
Felix

 

[NdNoviceHlp]

U can trial this in a blank wb. HTH. Dave

Option Explicit
Sub PicTest()
'place most recent pic on sheet1
Dim FS As Object, StrDirectory As String, Sh As Shape
Dim FL As Object, ObjFiles As Object, CountFiles As Integer
Dim TmpDate As Date, LastDate As Date, LastFile As String, P As Object

Set FS = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
StrDirectory = "C:\Users\fw\Desktop\Bilder Kamera"
Set ObjFiles = FS.GetFolder(StrDirectory).Files
'check for files
If Err.Number <> 0 Then
CountFiles = 0
Else
CountFiles = ObjFiles.Count
End If
On Error GoTo 0
If CountFiles = 0 Then
MsgBox "No files available."
Set ObjFiles = Nothing
Set FS = Nothing
Exit Sub
End If


'check for most recent pic file
For Each FL In ObjFiles
'MsgBox FL.Name
If Right(FL.Name, 3) = "jpg" Then
TmpDate = FL.datelastmodified
If TmpDate > LastDate Then
LastDate = TmpDate
LastFile = FL.Name
End If
End If
Next FL
'MsgBox LastFile
If LastFile = vbNullString Then
MsgBox "No pic files"
Exit Sub
End If

'remove previous picture in range A1:I20
With Sheets("Sheet1")
For Each Sh In .Shapes
If Application.Version > 12 Then
If Sh.Type = 11 Then
Sh.Delete
End If
Else
If Sh.Type = 13 Then
Sh.Delete
End If
End If
Next Sh
End With
Sheets("Sheet1").Range("A1:I20").ClearContents

'insert new picture in range A1:I20
With Sheets("Sheet1").Range("A1:I20")
'import picture
Set P = .Parent.Pictures.Insert(StrDirectory & "\" & LastFile)
'position picture
P.ShapeRange.LockAspectRatio = msoFalse
P.Top = .Top
P.Left = .Left
P.Width = .Width
P.Height = .Height
End With

Set P = Nothing
Set ObjFiles = Nothing
Set FS = Nothing
End Sub

ps. Welcome to the Board Felix! Please learn to use code tags.

 

[felix040893]

Hi Dave,
thanks for your response!! Your code works perfect.

I gave it another try myself before you were able to respond and was able to find a solution that works too. Could you help me with a short follow-up question that I have?

My issue right now is, that the picture always opens in the cell that I last clicked on with my cursor. I would like the picture to open in the same, specific cell every time i run the macro. E.g. every time I run the macro, I want the picture in cell C14. (Could also be a range if that makes it easier, e.g. C14:E16).

Also, is it possible to delete the older picture, if the macro detects and inserts a more recent picture?

I saw that you had those functions in your code. Is it possible to implement them in my code, too? Unfotunately I'm not experienced enough to do that without help..

This is the code I've been using (trying out the code tags now )

Sub BergaIIStationSued()
Dim myFile As String, myRecentFile As String, myMostRecentFile As String
Dim recentDate As Date
Dim myDirectory As String
myDirectory = "C:\Users\fw\Desktop\Bilder Berga II\"
Dim fileExtension As String
fileExtension = "IP Cam Station Sued*.jpg"


If Right(myDirectory, 1) <> "\" Then myDirectory = myDirectory & "\"


myFile = Dir(myDirectory & fileExtension)


If myFile <> "" Then
    myRecentFile = myFile
    recentDate = FileDateTime(myDirectory & myFile)
Do While myFile <> ""
    If FileDateTime(myDirectory & myFile) > recentDate Then
        myRecentFile = myFile
        recentDate = FileDateTime(myDirectory & myFile)
    End If
    myFile = Dir
Loop
End If
myMostRecentFile = myRecentFile
ActiveSheet.Pictures.Insert Filename:=myDirectory & myMostRecentFile




End Sub

Do you have any suggestions on how to solve this problem? Thanks a lot!
Felix

 

[felix040893]

Test

 

[felix040893]

Hi Dave,
thanks a lot for your help! Your code works well!

Before you were able to answer my question on here I was able to work out a code that worked, too. Do you think you could help me with two short follow-up questions that I have?

- Every time I run the macro, the picture is being opened in the cell, that I had last clicked on with my cursor. I would like the picture to open in the specific, same cell every time I run the macro (e.g. cell C14, or if easier a Range e.g. C14:E20)
- If the macro finds a more recent picture, I would like it to delete the "old" one that was placed in the cell before. If thats too complicated-no problem.

I saw that you had implemented similar functions in your code. Could you help me to integrate those functions in my code? Unfortunately I'm not experienced enough to apply them myself...

This is my code:

Sub BergaIIStationSued()
Dim myFile As String, myRecentFile As String, myMostRecentFile As String
Dim recentDate As Date
Dim myDirectory As String
myDirectory = "C:\Users\fw\Desktop\Bilder Berga II\"
Dim fileExtension As String
fileExtension = "IP Cam Station Sued*.jpg"


If Right(myDirectory, 1) <> "\" Then myDirectory = myDirectory & "\"


myFile = Dir(myDirectory & fileExtension)


If myFile <> "" Then
    myRecentFile = myFile
    recentDate = FileDateTime(myDirectory & myFile)
Do While myFile <> ""
    If FileDateTime(myDirectory & myFile) > recentDate Then
        myRecentFile = myFile
        recentDate = FileDateTime(myDirectory & myFile)
    End If
    myFile = Dir
Loop
End If
myMostRecentFile = myRecentFile
ActiveSheet.Pictures.Insert Filename:=myDirectory & myMostRecentFile




End Sub

Thank you for your help, Dave!
PS: Like my code tags?

 

[NdNoviceHlp]

Thanks for your response and for using code tags Felix. Thanks also for making the effort to code it for yourself. As for your questions, you're not telling XL where to insert the picture other than the active sheet and I assume that means it goes to the active cell of the active sheet. I'm not sure why U just don't use the code I posted? You can place the picture (and size it) to whatever range/sheet that U want. It also deletes any previous pictures before inserting a new picture. It adds some error prevention and more over, it avoids using the DIR function which I have found to be unreliable... occasionally a file will exist but DIR will simply ignore its' existence. To use your code....

'etc above code
myMostRecentFile = myRecentFile
'remove previous pictures in sheet 1
Dim Sh As Shape
With Sheets("Sheet1")
For Each Sh In .Shapes
If Application.Version > 12 Then
If Sh.Type = 11 Then
Sh.Delete
End If
Else
If Sh.Type = 13 Then
Sh.Delete
End If
End If
Next Sh
End With
Sheets("Sheet1").Range("C" & 14).ClearContents

With Sheets("Sheet1").Range("C" & 14)
.Pictures.Insert Filename:=myDirectory & myMostRecentFile
End With

Be aware that the code removes ALL pictures from Sheet1. Untested code. Good luck. Dave