title: Extract embedded files from word document
body: <p>I have word file that I need extract files from unzipping doesn't work as it is not giving out all files and naming is incorrect.
  I need to get out 5 type of files (word, excel, power point, rar and .pdf) don't care about others..
  Problem is that there are a lot of files that can't be opened as I don't have systems needed for that:
  How can I extract these files without opening embedded files:
  I have started 3 optional codes but they are nowhere near to finish as I don't have enough knowledge :(</p>
  
  <pre><code>Sub ExtractAndSaveEmbeddedFiles()
      Dim objEmbeddedShape As InlineShape
      Dim strShapeType As String, strEmbeddedDocName As String
      Dim objEmbeddedDoc As Object
      With ActiveDocument
          For Each objEmbeddedShape In .InlineShapes
              '  Find and open the embedded doc.
              Set objEmbeddedDoc = objEmbeddedShape.OLEFormat.Object
              strShapeType = objEmbeddedShape.OLEFormat.ClassType
              StrPath = "CXXXXPATH"
              OLEFormat.Save (StrPath + OLEFormat.SuggestedExtension)
              Set objEmbeddedDoc = Nothing
          Next objEmbeddedShape
      End With
  End Sub
  </code></pre>
  
  <pre><code>Sub ExtractAndSaveEmbeddedFiles()
      Dim objEmbeddedShape As InlineShape
      Dim strShapeType As String, strEmbeddedDocName As String
      Dim objEmbeddedDoc As Object
      With ActiveDocument
          For Each objEmbeddedShape In .InlineShapes
              '  Find and open the embedded doc.
              strShapeType = objEmbeddedShape.OLEFormat.ClassType
              If .OLEFormat.ClassType = "Excel.Sheet" Then
                  objEmbeddedShape.OLEFormat.Open
                  '  Initialization
                  Set objEmbeddedDoc = objEmbeddedShape.OLEFormat.Object
                  '  Save embedded files with names as same as those of icon label.
                  strEmbeddedDocName = objEmbeddedShape.OLEFormat.IconLabel
                  objEmbeddedDoc.SaveAs "XXXXPATH" &amp; strEmbeddedDocName
                  objEmbeddedDoc.Close
              End If
              Set objEmbeddedDoc = Nothing
          Next objEmbeddedShape
      End With
  End Sub
  </code></pre>
  
  <pre><code>Sub ExtractFiles()
      '
      ' ExtractFiles Macro
      '
      '
      Dim shape As InlineShape
      Dim folderName As String
      Dim a As Document
      folderName = "XXXXXPATH"
      For Each shape In ThisDocument.InlineShapes
          If (shape.Type = wdInlineShapeEmbeddedOLEObject) And (InStr(LCase(shape.OLEFormat.IconLabel), ".docx") &gt; 0) Then
              shape.OLEFormat.Object.SaveAs (folderName &amp; "\" &amp; shape.OLEFormat.IconLabel)
          End If
      Next shape
  End Sub
  </code></pre>