length of text input into text form field causing runtime error in vba?

[fingermouse]

Hi,

I was kindly given a piece of VBA code on here a while back (thanks Dominic!) which enabled me to export text form field data and radio button data from word to excel. When the macro runs, it places the output from the radio buttons in to a single excel worksheet and the output from the text form fields into another. The excel file is .xlsm macro enabled.

it works like a dream until I run the macro to include one of the longer text form fields responses, which includes 529 characters. This results in a 'type mismatch' error. I'm guessing it must exceed some kind of character limit? Or its something to do with the format of the text?

Here's the code:

Option Explicit

Sub ExportResponsesToExcel()

    Dim arrOptionButtons() As String
    Dim dicOptionButtons As Object
    Dim dicFormFields As Object
    Dim oInlineShape As InlineShape
    Dim oInlineShapes As InlineShapes
    Dim oOptionButton As OptionButton
    Dim oFormFields As FormFields
    Dim oFormField As FormField
    Dim Col As Long
    Dim oDoc As Document
    Dim xlApp As Object
    Dim xlWB As Object
    
    Set oDoc = ActiveDocument
    
    If oDoc Is Nothing Then
        MsgBox "No document is active.", vbExclamation
        Exit Sub
    End If
    
    Set oInlineShapes = oDoc.InlineShapes
    
    Col = 0
    If oInlineShapes.Count > 0 Then
        ReDim arrOptionButtons(1 To 2, 1 To oInlineShapes.Count)
        Set dicOptionButtons = CreateObject("Scripting.Dictionary")
        dicOptionButtons.CompareMode = vbTextCompare
        For Each oInlineShape In oInlineShapes
            If oInlineShape.Type = wdInlineShapeOLEControlObject Then
                If TypeName(oInlineShape.OLEFormat.Object) = "OptionButton" Then
                    Set oOptionButton = oInlineShape.OLEFormat.Object
                    If Not dicOptionButtons.Exists(oOptionButton.GroupName) Then
                        Col = Col + 1
                        arrOptionButtons(1, Col) = oOptionButton.GroupName
                        If oOptionButton.Value = True Then
                            arrOptionButtons(2, Col) = oOptionButton.Caption
                        End If
                        dicOptionButtons.Add oOptionButton.GroupName, Col
                    Else
                        If oOptionButton.Value = True Then
                            arrOptionButtons(2, dicOptionButtons(oOptionButton.GroupName)) = oOptionButton.Caption
                        End If
                    End If
                End If
            End If
        Next oInlineShape
        If Col > 0 Then
            ReDim Preserve arrOptionButtons(1 To 2, 1 To Col)
        End If
    End If
    
    Set oFormFields = oDoc.FormFields
    
    If oFormFields.Count > 0 Then
        Set dicFormFields = CreateObject("Scripting.Dictionary")
        dicFormFields.CompareMode = vbTextCompare
        For Each oFormField In oFormFields
            dicFormFields(oFormField.Name) = oFormField.Range.Text
        Next oFormField
    End If
    
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    On Error GoTo 0
    If xlApp Is Nothing Then
        Set xlApp = CreateObject("Excel.Application")
        xlApp.Visible = True
    End If
    
    Set xlWB = xlApp.workbooks.Add(-4167) 'create an XL workbook containing one worksheet
    
    With xlWB.activesheet
        .Range("A1").Value = "Form Field Name"
        .Range("B1").Value = "Form Field Text"
        If oFormFields.Count > 0 Then
            .Range("A2").Resize(dicFormFields.Count).Value = xlApp.transpose(dicFormFields.keys)
            .Range("B2").Resize(dicFormFields.Count).Value = xlApp.transpose(dicFormFields.items)
        End If
        .Columns("A:B").AutoFit
        .Name = "Form Fields"
    End With
    
    With xlWB.worksheets.Add
        .Range("A1").Value = "Question"
        .Range("B1").Value = "Response"
        If Col > 0 Then
            .Range("A2").Resize(Col, 2).Value = xlApp.transpose(arrOptionButtons)
        End If
        .Columns("A:B").AutoFit
        .Name = "Option Buttons"
    End With
    
    AppActivate xlWB.Name
    
    Set dicOptionButtons = Nothing
    Set dicFormFields = Nothing
    Set oInlineShape = Nothing
    Set oInlineShapes = Nothing
    Set oOptionButton = Nothing
    Set oFormField = Nothing
    Set oFormFields = Nothing
    Set oDoc = Nothing
    Set xlWB = Nothing
    Set xlApp = Nothing
    
End Sub

Any help would be very much appreciated! Thanks, Cal