Hi All,
In my VB.Net app, I want to read in a load of addresses from a database and then use word to create address labels on an Avery template L7163 which is then printed to the printer.
However, I have two issues:
1. Before word prints, I'm asked to select the printer etc. not exactly the nice automated application I was looking for.
2. Even though I get a nice printed out doc I was looking for, I also get a nasty looking error at the end which "loops" until I close my app
-2147417848: The object invoked has disconnected from its clients. (Exception from HRESULT: 0x800010108(RPC_E_DISCONNECTED))
Here is my code:
Dim oWord As New Word.Application 'hook into word
Dim wdDoc, wdDoc2 As Word.Document ' documents in word
Dim wdAutoText As Word.AutoTextEntry ' auto text for word
Dim dtAddresses As DataTable
Dim drAddress As DataRow
Dim intAddress As Integer = 0
Dim txtAddress As StreamWriter
Dim strAddressRow As String
Dim frmLabelTray As New frmLabelTray 'dialog that allows user to select tray type
Dim wdPrinterType As WdPaperTray 'Word Tray type
Dim diaResult As DialogResult
On Error GoTo ErrHandler
dtAddresses = objDb.GETAddressListForBatch(gintBatchNo)
'pulls back addresses in datatable
If dtAddresses Is Nothing Then
MsgBox("Unable to print labels, no address records were found", MsgBoxStyle.Exclamation + MsgBoxStyle.OkOnly, "Unable to Print Labels")
Resume OUT
Else
If dtAddresses.Rows.Count = 0 Then
MsgBox("Unable to print labels, no address records were found", MsgBoxStyle.Exclamation + MsgBoxStyle.OkOnly, "Unable to Print Labels")
Resume OUT
End If
End If
'we have records here or we'd have skipped to the OUT line
strCSVFile = objDb.GetMainPath & "Job Do\Job" & ReadibleNumber(gintJobID, 3) & "\Batch" & ReadibleNumber(gintBatchNo, 3) & "\Addresslist.csv"
'Address CSV file for mail merge
txtAddress = New StreamWriter(strCSVFile)
txtAddress.WriteLine("AddressID,Address1,Address2,Address3,Address4,Country")
For intAddress = 0 To dtAddresses.Rows.Count - 1
drAddress = dtAddresses.Rows(intAddress)
If Trim(drAddress.Item("JobNo").ToString) <> "" Then
strAddressRow = ReadibleNumber(drAddress.Item("JobNo").ToString, 3) & "_" & ReadibleNumber(gintBatchNo, 3) & "_" & ReadibleNumber(intAddress + 1, 3) & ","
Else
strAddressRow = ReadibleNumber(gintJobID, 3) & "_" & ReadibleNumber(gintBatchNo, 3) & "_" & ReadibleNumber(intAddress + 1, 3) & ","
End If
If Trim(drAddress.Item("ADDRESS1").ToString) <> "" Then
strAddressRow = strAddressRow & Replace(drAddress.Item("ADDRESS1").ToString, ",", "") & ","
Else
strAddressRow = strAddressRow & " ,"
End If
If Trim(drAddress.Item("ADDRESS2").ToString) <> "" Then
strAddressRow = strAddressRow & Replace(drAddress.Item("ADDRESS2").ToString, ",", "") & ","
Else
strAddressRow = strAddressRow & " ,"
End If
If Trim(drAddress.Item("ADDRESS3").ToString) <> "" Then
strAddressRow = strAddressRow & Replace(drAddress.Item("ADDRESS3").ToString, ",", "") & ","
Else
strAddressRow = strAddressRow & " ,"
End If
If Trim(drAddress.Item("ADDRESS4").ToString) <> "" Then
strAddressRow = strAddressRow & Replace(drAddress.Item("ADDRESS4").ToString, ",", "") & ","
Else
strAddressRow = strAddressRow & " ,"
End If
If Trim(drAddress.Item("COUNTRY").ToString) <> "" Then
strAddressRow = strAddressRow & Replace(drAddress.Item("COUNTRY").ToString, ",", "")
End If
txtAddress.WriteLine(strAddressRow)
Next
'have finished csv file
txtAddress.Close()
txtAddress = Nothing
With oWord
.DisplayAlerts = WdAlertLevel.wdAlertsNone
.Visible = False
End With
diaResult = frmLabelTray.ShowDialog
If diaResult = DialogResult.OK Then
wdPrinterType = CInt(frmLabelTray.txtTray.Text)
Else
wdPrinterType = WdPaperTray.wdPrinterAutomaticSheetFeed
End If
If InStr(oWord.ActivePrinter, strPrinter) = 0 Then
With oWord.Dialogs.Item(WdWordDialog.wdDialogFilePrintSetup)
.printer = MyPrinterValue 'got this from elsewhere in the app
.donotsetassysdefault = True
.Execute()
End With
End If
wdDoc = oWord.Documents.Add
With wdDoc.MailMerge
'insert the mail merge fields temporarily to use the range that contains the merge fields as a layout
With .Fields
.Add(oWord.Selection.Range, "Address1")
oWord.Selection.TypeParagraph()
.Add(oWord.Selection.Range, "Address2")
oWord.Selection.TypeParagraph()
.Add(oWord.Selection.Range, "Address3")
oWord.Selection.TypeParagraph()
.Add(oWord.Selection.Range, "Address4")
oWord.Selection.TypeParagraph()
.Add(oWord.Selection.Range, "Country")
oWord.Selection.TypeParagraph()
.Add(oWord.Selection.Range, "AddressID")
End With
wdAutoText = oWord.NormalTemplate.AutoTextEntries.Add("MyLabelLayout", wdDoc.Content)
wdDoc.Content.Delete() 'we no longer need this as we have added it as autotext
End With
oWord.ActiveDocument.MailMerge.MainDocumentType = WdMailMergeMainDocType.wdMailingLabels
oWord.ActiveDocument.MailMerge.OpenDataSource(Name:=strCSVFile, ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, Format:=WdOpenFormat.wdOpenFormatAuto, Connection:="", SQLStatement:="", SQLStatement1:="")
oWord.MailingLabel.DefaultPrintBarCode = False
wdDoc2 = oWord.MailingLabel.CreateNewDocument(Name:="L7163", Address:="", AutoText:="MyLabelLayout", LaserTray:=wdPrinterType)
oWord.ActiveDocument.MailMerge.DataSource.QueryString = "SELECT * FROM " & strCSVFile
With oWord.ActiveDocument.MailMerge
.Destination = WdMailMergeDestination.wdSendToPrinter
.MailAsAttachment = False
.MailAddressFieldName = ""
.MailSubject = ""
.SuppressBlankLines = True
With .DataSource
.FirstRecord = WdMailMergeDefaultRecord.wdDefaultFirstRecord
.LastRecord = WdMailMergeDefaultRecord.wdDefaultLastRecord
End With
.Execute(Pause:=True)
End With
OUT:
'close everything up
If Not txtAddress Is Nothing Then
txtAddress.Close()
txtAddress = Nothing
End If
If Not wdDoc2 Is Nothing Then
wdDoc2.Close(False)
wdDoc2 = Nothing
End If
If Not wdDoc Is Nothing Then
wdDoc.Close(False)
wdDoc = Nothing
End If
If Not oWord Is Nothing Then
oWord.Quit(False)
oWord = Nothing
End If
Exit Sub
ErrHandler:
MsgBox("Mail Merge Error " & Err.Number & ": " & Err.Description, MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "Mail Merge Error")
Err.Clear()
Resume OUT
End SubI adapted the code for the actual mail merge by recording a Macro in Word As I manually ran one so I thought it would be ok.