slim7
08-03-2006, 02:43 PM
I was given a large text file and a mail merge template. I need to loop through all the records and create word docs and store them. I'd like to go on to the next record if the record that don't have all the fields. (Error msg: 'record xxx contained too few data fields') error message at line .activerecord and I have to hit return each time. Is there a way to not display the error message and continue looping without user intervention?
Sub AutoOpen()
On Error GoTo err
Dim doc As Document
Set doc = ActiveDocument
Dim datarecs, i, x, y
Dim mailMergeDataSource1 As MailMergeDataSource
Dim returnvalue As String
Dim theclient, thereviewerflag, thedata, thefilename, thetype, thesavefile As String
With Application
'Application.DisplayAlerts = False
Application.DisplayAlerts = Word.WdAlertLevel.wdAlertsNone
End With
x = 3240
With ActiveDocument.MailMerge
.OpenDataSource Name:="D:\temp\data_extract.txt", _
Format:=wdOpenFormatText, addtorecentfiles:=False
For i = x To 4000
With ActiveDocument.MailMerge.DataSource
.ActiveRecord = i
returnvalue = .mappedDataFields.Count
thefilename = .DataFields("pkey").Value
thetype = .DataFields("entity_type").Value
End With
If thetype = "Corporation" And returnvalue = 30 Then
.DataSource.FirstRecord = i
.DataSource.LastRecord = i
.Destination = wdSendToNewDocument
.Execute
thesavefile = "f:\temp\" + thefilename
ActiveDocument.SaveAs (thesavefile)
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
End If
Next i
End With
err:
Resume Next
End Sub
Sub AutoOpen()
On Error GoTo err
Dim doc As Document
Set doc = ActiveDocument
Dim datarecs, i, x, y
Dim mailMergeDataSource1 As MailMergeDataSource
Dim returnvalue As String
Dim theclient, thereviewerflag, thedata, thefilename, thetype, thesavefile As String
With Application
'Application.DisplayAlerts = False
Application.DisplayAlerts = Word.WdAlertLevel.wdAlertsNone
End With
x = 3240
With ActiveDocument.MailMerge
.OpenDataSource Name:="D:\temp\data_extract.txt", _
Format:=wdOpenFormatText, addtorecentfiles:=False
For i = x To 4000
With ActiveDocument.MailMerge.DataSource
.ActiveRecord = i
returnvalue = .mappedDataFields.Count
thefilename = .DataFields("pkey").Value
thetype = .DataFields("entity_type").Value
End With
If thetype = "Corporation" And returnvalue = 30 Then
.DataSource.FirstRecord = i
.DataSource.LastRecord = i
.Destination = wdSendToNewDocument
.Execute
thesavefile = "f:\temp\" + thefilename
ActiveDocument.SaveAs (thesavefile)
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
End If
Next i
End With
err:
Resume Next
End Sub