welshgasman
Well-known Member
- Joined
- May 25, 2013
- Messages
- 1,402
- Office Version
- 2019
- 2007
- Platform
- Windows
Hi all,
I volunteer for a local Community Car Scheme and we wanted an easy way to keep our passenger list up to date. Previously it was a paper address book.
So I created an Excel workbook, with a sheet for each alpha character and a word mailmerge document to print the addresses for an A5 polypocket.
All seemed to go well with some help on another forum for the SQL for the mailmerge via VBA.
However my controller has notified me that some numbers (atm they appear to be just the mobile numbers, and only a few) come out on the sheet as 0.
I have had a quick look at the excel workbook, and those numbers appear fine, no leading or trailing spaces, and the majority do work, so not just a leading zero issue?
I cannot upload the workbook at present due to the sensitive nature of the data, but was wondering if anyone had come across this before.
It is not any of my conditional fields in the word docuument, I confirmed the value is 0 from the Select via Edit recipient list.
TIA
Here is the code for the mailmerge
I volunteer for a local Community Car Scheme and we wanted an easy way to keep our passenger list up to date. Previously it was a paper address book.
So I created an Excel workbook, with a sheet for each alpha character and a word mailmerge document to print the addresses for an A5 polypocket.
All seemed to go well with some help on another forum for the SQL for the mailmerge via VBA.
However my controller has notified me that some numbers (atm they appear to be just the mobile numbers, and only a few) come out on the sheet as 0.
I have had a quick look at the excel workbook, and those numbers appear fine, no leading or trailing spaces, and the majority do work, so not just a leading zero issue?
I cannot upload the workbook at present due to the sensitive nature of the data, but was wondering if anyone had come across this before.
It is not any of my conditional fields in the word docuument, I confirmed the value is 0 from the Select via Edit recipient list.
TIA
Here is the code for the mailmerge
Code:
Sub Merge_Sheet(pstrSheet As String, pAll As Boolean)
' Sourced from: http://www.vbaexpress.com/forum/showthread.php?70461-Change-Word-mailmerge-source-with-VBA
' Note: this code requires a reference to the Word object model to be set, via Tools|References in the VBE.
On Error GoTo Err_Handler
Application.ScreenUpdating = False
Dim StrMMSrc As String, StrMMDoc As String, StrMMPath As String, StrName As String, strPDFName As String
Dim iLastRow As Integer
Dim wdApp As New Word.Application, wdDoc As Word.Document
StrMMSrc = ThisWorkbook.FullName
StrMMPath = ThisWorkbook.Path & "\"
StrMMDoc = StrMMPath & "GCCS Address Details 7165 MM.docx"
StrName = pstrSheet 'ActiveSheet.Name
Worksheets(StrName).Range("A:J").Columns.AutoFit
' Now get rid of any cells that inflate the used range.
DeleteUnusedRange
'Now sort the sheet for any new entries. Output seems to differ from displayed after sort, so switch back on and off
SortAlpha (StrName)
If Trim(StrName) = "" Then Exit Sub
'Trim Filter column else we get extra records with no values
iLastRow = GetLastRow(StrName, "A") + 1
'ActiveSheet.Range("A" & iLastRow & ":J1000").ClearContents
'ActiveSheet.Range("A" & iLastRow & ":J1000").Delete
wdApp.Visible = True
wdApp.WordBasic.DisableAutoMacros
wdApp.DisplayAlerts = wdAlertsNone
'StrMMDoc = StrMMPath & "MailMergeMainDocument.doc"
Set wdDoc = wdApp.Documents.Open(Filename:=StrMMDoc, AddToRecentFiles:=False, ReadOnly:=True, Visible:=False)
With wdDoc
With .MailMerge
.MainDocumentType = wdMailingLabels
.OpenDataSource Name:=StrMMSrc, 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 `" & StrName & "$` "
.Execute Pause:=False
.MainDocumentType = wdNotAMergeDocument
End With
' .Close SaveChanges:=False
' Document has extra pages with empty labels, unable to find out why.
'Save as PDF file
strPDFName = "GCCS Passengers - " & StrName
With wdApp.ActiveDocument
.SaveAs Filename:=StrMMPath & strPDFName & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
.Close SaveChanges:=False
End With
wdDoc.Close SaveChanges:=False
'wdApp.Documents("Labels1").ExportAsFixedFormat OutputFileName:= _
' StrMMPath & strPDFName & ".pdf", _
' ExportFormat:=wdExportFormatPDF, _
' OpenAfterExport:=True, _
' OptimizeFor:=wdExportOptimizeForPrint, _
' Range:=wdExportAllDocument, _
' IncludeDocProps:=True, _
' CreateBookmarks:=wdExportCreateWordBookmarks, _
' BitmapMissingFonts:=True
End With
wdApp.DisplayAlerts = wdAlertsAll
If Not pAll Then
MsgBox "Mailmerge document created " & StrMMPath & strPDFName & ".pdf"
End If
wdApp.Quit
ActiveWorkbook.FollowHyperlink StrMMPath & strPDFName & ".pdf"
Err_Resume:
Set wdDoc = Nothing
Set wdApp = Nothing
Application.ScreenUpdating = True
' Now show the results
Exit Sub
Err_Handler:
MsgBox "Error " & Err.Number & " - " & Err.Description
Resume Err_Resume
End Sub
Last edited: