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
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