Pasting the most recent JPG into a spreadsheet

dlo1503

New Member
Joined
Feb 24, 2020
Messages
19
Office Version
  1. 365
Platform
  1. Windows
Hello

I am trying to write a code to input the most recent JPG in a folder into a cell in a spreadsheet. The cell destination will never change. The code currently asks for a folder to select from but this is unnecessary as the folder is always the same (C:\Users\Cad User5\Pictures\Camera Roll)

I would also like the photo to be sized to Cell I2 which is a merged cell from I2 : T26. Currently it runs over the size of the cell.

Many thanks
Daniel

ub Insert_Newest_JPG()

Dim rngDest As Range
Dim FSO As Object
Dim oFile As Object
Dim oPic As Object
Dim dTimeNow As Double
Dim dTimeSince As Double
Dim strFolderPath As String
Dim strFilePath As String

With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = False Then Exit Sub
strFolderPath = .SelectedItems(1)
End With


dTimeNow = Now
dTimeSince = 1000000
Set FSO = CreateObject("Scripting.FileSystemObject")

For Each oFile In FSO.GetFolder(strFolderPath).Files
If Right(oFile.Name, 4) = ".jpg" Then
If dTimeNow - oFile.DateLastModified < dTimeSince Then
dTimeSince = dTimeNow - oFile.DateLastModified
strFilePath = oFile.Path
End If
End If
Next oFile

If Len(strFilePath) > 0 Then
Set oPic = LoadPicture(strFilePath)
On Error Resume Next
Set rngDest = ActiveSheet.Range("i2")
On Error GoTo 0
If rngDest Is Nothing Then Exit Sub
Set rngDest = rngDest.Cells(1)
ActiveSheet.Shapes.AddPicture strFilePath, msoFalse, msoTrue, rngDest.Left, rngDest.Top, Round(oPic.Width / 26.458, 0), Round(oPic.Height / 26.458, 0)
Else
MsgBox "No .jpg files found in " & strFolderPath, , "Insert Image Error"
End If

End Sub
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,977
Office Version
  1. 365
Platform
  1. Windows
Remember to use code tags when pasting code

Try this
VBA Code:
Sub Insert_Newest_JPG()

    Dim rngDest As Range
    Dim FSO As Object
    Dim oFile As Object
    Dim oPic As Object
    Dim dTimeNow As Double
    Dim dTimeSince As Double
    Dim strFilePath As String
    Dim merged As Range
    Set merged = ActiveSheet.Range("I2").MergeArea
    Const strFolderPath As String = "C:\Users\Cad User5\Pictures\Camera Roll"
        
    dTimeNow = Now
    dTimeSince = 1000000
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    For Each oFile In FSO.GetFolder(strFolderPath).Files
        If Right(oFile.Name, 4) = ".jpg" Then
            If dTimeNow - oFile.DateLastModified < dTimeSince Then
                dTimeSince = dTimeNow - oFile.DateLastModified
                strFilePath = oFile.Path
            End If
        End If
    Next oFile
    
    If Len(strFilePath) > 0 Then
        Set oPic = LoadPicture(strFilePath)
        On Error Resume Next
        Set rngDest = ActiveSheet.Range("i2")
        On Error GoTo 0
        If rngDest Is Nothing Then Exit Sub
    
        Set rngDest = rngDest.Cells(1)
        ActiveSheet.Shapes.AddPicture strFilePath, msoFalse, msoTrue, rngDest.Left, rngDest.Top, Round(oPic.Width / 26.458, 0), Round(oPic.Height / 26.458, 0)
        With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
            .Width = merged.Width
            .Height = WorksheetFunction.Min(.Height, merged.Height)
        End With
    Else
        MsgBox "No .jpg files found in " & strFolderPath, , "Insert Image Error"
    End If
    
End Sub
 

dlo1503

New Member
Joined
Feb 24, 2020
Messages
19
Office Version
  1. 365
Platform
  1. Windows
Perfect Yongle, works like a dream. Appreciate the help
 

Watch MrExcel Video

Forum statistics

Threads
1,132,782
Messages
5,655,268
Members
418,183
Latest member
skaufman

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top