Copy an embedded word document and paste into a folder

Try something like this. Change the save path to suit.

Sub Save_Embedded_Word_Docs()
    
    Dim ws As Worksheet
    Dim oleObj As Object
    Dim counter As Long
    Dim strPath As String
    
    strPath = "C:\Test\"    'Word doc save folder
    
    Application.ScreenUpdating = False
    For Each ws In Worksheets
        For Each oleObj In ws.OLEObjects
            If oleObj.progID Like "Word.Doc*" Then
                oleObj.Verb Verb:=xlPrimary
                Application.Goto ws.Range("A1")
                counter = counter + 1
                oleObj.Object.SaveAs strPath & oleObj.Parent.Name & Format(Now, " yyyymmdd hhmmss ") & counter & ".doc"
            End If
        Next
    Next ws
    Application.ScreenUpdating = True
    
    MsgBox counter & " files saved.", , "Save Word Docs Complete"
    
End Sub

Public Sub SaveEmbDocs()

    Dim sht As Worksheet
    Dim Word As Word.Application
    Dim Doc As Word.Document
    Dim embDoc As Object
    Dim DocPath As String
    
    Set sht = ThisWorkbook.Sheets("Sheet1") 'Change the sheetname to you requirements
    DocPath = ThisWorkbook.Path & "\" 'Add the desired folder here
    
    
    On Error Resume Next
    Set Word = GetObject(, "Word.Application")
    If Err.Number <> 0 Then 'Check if Word is already running
        Set Word = CreateObject("Word.Application")
    End If
    On Error GoTo 0

    'Go thru all oleobjects on Sheet1
    For Each oleObj In sht.OLEObjects
        If LCase(Left(oleObj.progID, 4)) = "word" Then 'Only save Word docs
            Set embDoc = oleObj
            embDoc.Verb Verb:=xlOpen
            'Do not show the documents
            Word.Visible = False
            Word.WindowState = wdWindowStateMinimize
            Set Doc = Word.ActiveDocument
            'Haven't succeeded to retrieve the document filename (yet)
            Doc.SaveAs DocPath & sht.Name & "_EmbDoc_" & oleObj.Name & ".docx", FileFormat:=wdFormatXMLDocument
            Doc.Close False
        End If
    Next oleObj
    
    Set Word = Nothing
    Set Doc = Nothing
    Set embDoc = Nothing

End Sub

Retrieving the full name and path of the documents is only possible when "link to file" has been selecting when they where inserted.
Are the files in your workbook linked or just embedded?