Extracting MTXT including fields to Excel

[Glen1980]

I always like the Sam Smiths pubs particularly the Princess Louise or the Citte of Yorke. Cheap, good beer and you can hear each other talk!

 

Wasn't there talk of a London meet up at one stage a few years back?

[Tyke]

I always like the Sam Smiths pubs particularly the Princess Louise or the Citte of Yorke. Cheap, good beer and you can hear each other talk!

 

Wasn't there talk of a London meet up at one stage a few years back?

 

Sam Smiths, a good old Yorkshire beer from Tadcaster, my neck of the woods.

 

Yes, there was going to be a meet up to celebrate the 100th edition of Michael Beall's 'Michaels Corner', but it was cancelled due to lack of interest. I know Michael is till interested if a enough people could manage it. I'd be more than willing to come over from Germany should it take place.

[Tyke]

If you use my original code on multiline MText you will get a single line of text in Excel with "\P" representing the new line breaks. I've fixed this in the code here and also allowed normal text entities to be selected.

 

Public Sub ToExcel()

   Dim strText       As String
   Dim objEnt        As AcadEntity
   Dim varInsPt      As Variant
   Dim Row           As Integer
   Dim Col           As Integer
   Dim i             As Integer
   Dim ExcelApp      As Object
   Dim ExcelSheet    As Object
   Dim ExcelWorkbook As Object
   Dim vSplits()     As String
   Dim e             As Integer
   
   Set ExcelApp = GetObject(, "Excel.application")
   Set ExcelWorkbook = ExcelApp.ActiveWorkbook
   Set ExcelSheet = ExcelApp.activesheet

   Row = ExcelApp.ActiveCell.Cells.Row
   Col = ExcelApp.ActiveCell.Cells.Column
   
   i = 1
   Err.Clear
   On Error Resume Next
   
   ThisDrawing.Utility.GetEntity objEnt, varInsPt, vbCr & " Select text: "
   Do While Err.Number = 0
       If objEnt.ObjectName = "AcDbMText" Then
           strText = objEnt.TextString
           vSplits = Split(strText, "\P")
           If UBound(vSplits) > 0 Then
               strText = vSplits(0)
               For e = 1 To UBound(vSplits)
                   strText = strText & Chr(10) & vSplits(e)
               Next e
           End If
       ElseIf objEnt.ObjectName = "AcDbText" Then
           strText = objEnt.TextString
       End If
       ExcelSheet.Cells(Row, Col).Value = strText
       Row = Row + 1
       i = i + 1
       ThisDrawing.Utility.GetEntity objEnt, varInsPt, " Select text: "
   Loop
End Sub