title: Multiple images into excel using VBA
body: <p>I have to write a script that parses the images from ppt and dumps into excel. To do this, I first export all the images in the slides to a folder and then call excel Application to import them into the worksheet. The following code, which I found online, with my modifications is as follows:</p>
  
  <pre><code>Sub ExtractImagesFromPres()
  
  Dim oSldSource As Slide
  Dim oShpSource As Shape
  Dim Ctr As Integer
  Dim ObjExcel As Object
  Dim wb As Object
  Dim ws As Object
  Set ObjExcel = CreateObject("Excel.Application")
  Dim sPath As String
  
  sPath = "C:\Users\Aravind_Sampathkumar\Documents\Expor"
  Ctr = 0
  
  Set wb = ObjExcel.Workbooks.Open("C:\Users\Aravind_Sampathkumar\Documents\Book1.xlsx")
  Set ws = wb.Sheets(1)
  
  'Open oPres.Path &amp; PathSep &amp; "Book1.CSV" For Output As iFile
  
  For Each oSldSource In ActivePresentation.Slides
      For Each oShpSource In oSldSource.Shapes
  
          If oShpSource.Type = msoPicture Then
  
          ' Hidden Export method
  
          Call oShpSource.Export(sPath &amp; "Img" &amp; Format(Ctr, "0000") &amp; ".JPG", ppShapeFormatJPG)
  
  
          Ctr = Ctr + 1
          End If
  
          Next oShpSource
  Next oSldSource
  
  
  Folderpath = "C:\Users\Aravind_Sampathkumar\Documents\Expor"
  Set fso = CreateObject("Scripting.FileSystemObject")
  NoOfFiles = fso.GetFolder(Folderpath).Files.Count
  Set listfiles = fso.GetFolder(Folderpath).Files
  counter = 1
  For Each fls In listfiles
      strCompFilePath = Folderpath &amp; "\" &amp; Trim(fls.Name)
          If strCompFilePath &lt;&gt; "" Then
              If (InStr(1, strCompFilePath, "jpg", vbTextCompare) &gt; 1 _
              Or InStr(1, strCompFilePath, "jpeg", vbTextCompare) &gt; 1 _
              Or InStr(1, strCompFilePath, "png", vbTextCompare) &gt; 1) Then
  
              counter = counter + 1
             ' ws.Range("C" &amp; counter).Value = fls.Name
              ws.Range("D" &amp; counter).ColumnWidth = 25
              ws.Range("D" &amp; counter).RowHeight = 100
              ws.Range("D" &amp; counter).Activate
              'Call insert(strCompFilePath, counter)
              ws.Shapes.AddPicture strCompFilePath, True, True, 100,100,70,70
              End If
          End If
  Next
  'ws.Shapes.AddPicture ("C:\Users\Aravind_Sampathkumar\Documents")
       'With .ShapeRange
        '  .LockAspectRatio = msoTrue
         ' .Width = 100
          '.Height = 100
      'End With
     ' .Left = ws.Cells(i, 20).Left
      '.Top = ws.Cells(i, 20).Top
      '.Placement = 1
      '.PrintObject = True
  'End With
  End Sub
  </code></pre>
  
  <p>When I run it, the images get dumped into excel but all the images are overlapped on each other in the same cell. Is there any way I can modify it such that images go into consecutive rows? 1 image per row?</p>