' Go to Tools -> References... and check "Microsoft Scripting Runtime" 
' to be able to use the FileSystemObject

Sub CleanData()

Dim masterDoc As Document, field As String, line As String, lastRecordNum As Long, filePath As String, fso As FileSystemObject, fileStream As TextStream
Set masterDoc = ActiveDocument
filePath = "C:\temp\MyTestFile.txt"
If Dir("C:\temp\") = "" Then MkDir "C:\temp\"
Set fso = New FileSystemObject
Set fileStream = fso.CreateTextFile(filePath)
masterDoc.MailMerge.DataSource.ActiveRecord = wdLastRecord
lastRecordNum = masterDoc.MailMerge.DataSource.ActiveRecord
masterDoc.MailMerge.DataSource.ActiveRecord = wdFirstRecord
If masterDoc.MailMerge.DataSource.Type = _
    wdMergeInfoFromWord Then
    'Create FieldName Line
    With masterDoc.MailMerge
      For Each aname In .DataSource.DataFields
          field = LTrim(RTrim(aname.Name))
            If Len(line) < 1 Then
            line = line & field
            Else
            line = line & "|" & field
            End If
      Next aname
     End With
          fileStream.WriteLine line
' Loop Through Data and trim whitespace from both sides. Space and tab
    Do While lastRecordNum > 0
        With masterDoc.MailMerge
            line = """"
          For Each afield In .DataSource.DataFields
            field = TrimAll(afield.Value)
            If Len(line) < 2 Then
            line = line & field
            Else
            line = line & """|""" & field
            End If
          Next afield
          line = line & """"
         End With
          fileStream.WriteLine line
         
        If masterDoc.MailMerge.DataSource.ActiveRecord >= lastRecordNum Then
            lastRecordNum = 0
        Else
            masterDoc.MailMerge.DataSource.ActiveRecord = wdNextRecord
        End If
    Loop
    fileStream.Close
    'Connect to new file
ary = Split(filePath, "\")
With ActiveDocument.MailMerge
  .OpenDataSource Name:=filePath, ReadOnly:=True, AddToRecentFiles:=False, _
    LinkToSource:=False, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;" & _
    "Data Source=StrMMSrc;Mode=Read;Extended Properties=""HDR=YES;IMEX=1"";", _
    SQLStatement:="SELECT * FROM " & ary(UBound(ary))
End With
End If

End Sub

'Function to Trim whitespace.
Private Function TrimAll(Text As String) As String

Const toRemove As String = " " & vbTab & vbCr & vbLf 'what to remove

Dim s As Long: s = 1
Dim e As Long: e = Len(Text)
Dim c As String

If e = 0 Then Exit Function 'zero len string

Do 'how many chars to skip on the left side
    c = Mid(Text, s, 1)
    If c = "" Or InStr(1, toRemove, c) = 0 Then Exit Do
    s = s + 1
Loop
Do 'how many chars to skip on the right side
    c = Mid(Text, e, 1)
    If e = 1 Or InStr(1, toRemove, c) = 0 Then Exit Do
    e = e - 1
Loop
TrimAll = Mid(Text, s, (e - s) + 1) 'return remaining text

End Function