![]() |
|
#1
|
|||
|
|||
![]()
I am working on a Word document that uses an export from our accounting software. We have no control over how this data is provided to us. This is for listing transactions and emailing them a remittance. There is a "Table" in the doc that is really just one field per line. They send the whole line as one field and if the line is blank we get several spaces, so line suppression is not working.
I would like to clean up the fields and remove the leading and tailing spaces. It would be even better if I could split a field into several to become a better output. Sometimes their output field wraps around to the next line and the "Columns do not line up. I tried adding =Trim(<<mergefield>>) but it did not like that either. I feel like we can do this with EditDataSource but the only examples I can find are about adding a line, not looping through each, and modifying the value. This is what I have been trying but Datafields.Value is Read Only. Code:
Sub CleanData() Dim masterDoc As Document, singleDoc As Document, field As String, cols As Integer, rows As Integer Set masterDoc = ActiveDocument Set singleDoc = Documents.Add If masterDoc.MailMerge.DataSource.Type = _ wdMergeInfoFromWord Then With masterDoc.MailMerge .EditDataSource For Each afield In .DataSource.DataFields field = Trim(afield.Value) afield.Value = field singleDoc.Content.InsertAfter Text:=afield.Name & ":" & afield.Value & vbCrLf Next afield End With End If End Sub Here is some sample data. It is the L## fields that are the biggest issue. sampleData.txt This is the issue we get with some of the remittances: Bad: RemirBadLines.png Normal: remitGoodLines.png I hope this makes sense, I was interrupted a few times writing this. Thanks for any help, Luke |
#2
|
|||
|
|||
![]()
If anyone is curious. I ended up creating a new text file and connecting to that as the data source. The below code is what is working.
The TrimAll function was found here in Ovidiu Luca's answer. Code:
' 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 |
![]() |
Tags |
editdatasource, mailmerge field, vba |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
jeffreybrown | Word VBA | 2 | 09-04-2018 07:36 PM |
Data Entry - Getting spreadsheets back with excess space but the TRIM function doesn't work | jhato160 | Excel | 5 | 06-17-2016 04:06 AM |
Merge fields in Word and source data from Excel | SteveVai | Mail Merge | 3 | 03-13-2014 05:25 AM |
![]() |
freefalladdict | Word | 3 | 01-08-2012 02:23 PM |
How do I set up the fields in mail merge word 07 from my data base | mbcrabber | Mail Merge | 4 | 06-06-2010 01:25 PM |