Concatenate & Transpose from one file to another

[Fenix Kage]

I have a large project which involves taking the text from 500 powerpoints and inputting that into a single worksheet. I've found a PPT macro that will export the text from the active PPT to Alltext.CSV (worksheet: Alltext). When I try to have it export as an XLSX or XLSM, it won't open, so I hope having a CSV in the process won't be an issue; however, I don't believe it will since the macro itself will be running from an XLSM.

The data goes into the CSV with each row being a slide, and each slide taking up a random number of rows, sometimes with blank cells in between (as shown below). What I need is a macro that will concatenate those rows into one cell, ignoring the blank ones, and having " / " as a separator. Then transpose the resultant column into the first blank row of column H of the worksheet "PPT" in the file "MasterList.xlsm."

Here's an example of what I'm starting with from PPT1 in Alltext.csv

[TABLE="class: grid, width: 150, align: center"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]2[/TD]
[TD][/TD]
[TD]3[/TD]
[TD]4[/TD]
[/TR]
[TR]
[TD]D[/TD]
[TD][/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

And this is the result I need in MasterList.xlsm:

[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD]PPT1[/TD]
[TD]A / B / C[/TD]
[TD]1 / 2 / 3 / 4[/TD]
[TD]D / E / F[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]PPT2[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


Ultimately, the purpose is to allow me to search for a phrase in all the PPTs, and know exactly which file and page the phrase is located in.


Here is the starting PPT macro, in case it can be amended to do the job of both.

Sub ExportTextToCSV()

  Dim oPres As Presentation
  Dim oSlides As Slides
  Dim oSld As Slide         'Slide Object
  Dim oShp As Shape         'Shape Object
  Dim iFile As Integer      'File handle for output
  Dim sTempString As String

  Dim PathSep As String
  Dim Quote As String
  Dim Comma As String
  iFile = FreeFile          'Get a free file number

  #If Mac Then
    PathSep = ":"
  #Else
    PathSep = "\"
  #End If

  Quote = Chr$(34)
  Comma = ","

  Set oPres = ActivePresentation
  Set oSlides = oPres.Slides

  'Open output file
  ' NOTE:  errors here if original PPT file hasn't been saved
  Open oPres.Path & PathSep & "AllText.CSV" For Output As iFile

  For Each oSld In oSlides    'Loop thru each slide
    For Each oShp In oSld.Shapes                'Loop thru each shape on slide

      'Check to see if shape has a text frame and text
      If oShp.HasTextFrame And oShp.TextFrame.HasText Then
          sTempString = sTempString & Quote & oShp.TextFrame.TextRange.Text & Quote & Comma
      End If

    Next oShp

    ' print the result to file:
    Print #iFile, sTempString
    sTempString = ""

  Next oSld

  'Close output file
  Close #iFile

End Sub