VBA Excel Saving embedded OLE object

I have lot of workbooks which have embedded objects (images, pdf and zip files) and I need to extract those files to hard disk. I have found this code:

Sub Test()
 'copy oleobject
 ActiveSheet.OLEObjects("Objeto 3").Copy
 'paste to activeworkbook's path
 CreateObject("Shell.Application") _
 .Namespace(ActiveWorkbook.Path) _
 .Self.InvokeVerb "Paste"
End Sub

but the problem is that I get a file without extension.

I need get the name of the object that appears in this image

but I haven't found a method to get those names.

Can someone help me?

As far as I'm aware, there's no way of getting or setting the Icon Caption for an embedded OLE Object through VBA.

However, you may still be able to determine which file extension to apply based on the file type and/or application used to open the file:

FileType: TypeName(ws.OLEObjects(shp.Name).Object)

Application: ws.OLEObjects(shp.Name).Object.Application.Name

Some filetypes can be detected without opening (e.g Excel files), but most filetypes (including PDF) seem to need to be opened first.

Some filetypes can't be detected even after opening, such as image files. If all other filetypes that exist in your workbook can be detected, and all images are jpg, then you can assign the filetype in an error handler.

After detecting the filetype for each OLEObject, you can then assign an appropriate file extension.

It should also be possible to close most if not all files programmatically after opening them.

Below is a sample loop for getting the name, filetype and application for all OLE Objects in the ActiveSheet:

Sub GetTypes()

    On Error GoTo Image
    
    For Each shp In ActiveSheet.Shapes
        If shp.Type = 7 Then 'OLE
            strName = shp.Name
            With ActiveSheet.OLEObjects(strName)
                .Verb xlVerbOpen
                strFileType = TypeName(.Object)
                strApplication = .Object.Application.Name
            End With
        End If
    Next shp
    
    Exit Sub
    
Image:
    strFileType = "Image"
    strApplication = ""
    Resume Next

End Sub

It also seems you'll get a popup when trying to open images, but the loop will continue after you click OK.