excel all picture save in a folder to use vba code

 Sub ExportImages_ExtendOffice()
'Updated by Extendoffice 20220308
    Dim xStrPath As String
    Dim xStrImgName As String
    Dim xImg As Shape
    Dim xObjChar As ChartObject
    Dim xFD As FileDialog
    Set xFD = Application.FileDialog(msoFileDialogFolderPicker)
    xFD.Title = "Please select a folder to save the pictures" & " - ExtendOffice"
    If xFD.Show = -1 Then
       xStrPath = xFD.SelectedItems.Item(1) & "\"
    Else
        Exit Sub
    End If
   
    On Error Resume Next
    For Each xImg In ActiveSheet.Shapes
        If xImg.TopLeftCell.Column = 6 Then
        xStrImgName = xImg.TopLeftCell.Offset(0, -1).Value
        If xStrImgName <> "" Then
            xImg.Select
           
            Selection.Copy
            Set xObjChar = ActiveSheet.ChartObjects.Add(0, 0, xImg.Width, xImg.Height)
            With xObjChar
                .Border.LineStyle = xlLineStyleNone
                .Activate
                ActiveChart.Paste
                .Chart.Export xStrPath & xStrImgName & ".png"
                .Delete
            End With
        End If
        End If
    Next
End Sub


##############################################################
ms access image path
=[CurrentProject].[Path] & "\images\" & [Item No].[png]
=CurrentProject.Path & Item No
?CurrentProject.Path & "\" & CurrentProject.Name   in vba

F:\Rai Singh Rana\Site data\products images with id no\1.png