Hi All
I am using Excel as a frontend and Access as a backend. Now in the main form the user types in all the information about a customer and press Save. Suppose he stores 10 customers details so I am using PrintSpool Number . For those 10 records the printspool number will be save so that when the user press Print button then all those 10 Word document letters will get printed off. This works absolutely fine. Now I want to do the following checks in the code while printing:
It will make it easier on the watermark issue as it changes the below
First check
IF AXAFRIENDS = FLC use NO WATERMARK and END conditional (do not do second or third check)
IF FALSE move to second check
Second check
IF Team = LTC use LTC and END conditional (do not do third check)
IF Team = WINTERTHUR use WLUKCAP4 and END conditional (do not do third check)
IF FALSE move to third check
Third check
IF AXAFRIENDS = FRIENDS use PAP107 and END conditionals
IF AXAFRIENDS = DM use PAPSLD and END conditionals
AXAFRIENDS is the name of the field and the above conditions will result in different watermarks for each customer letter. My code doesn't work as required. Suppose 10 records in Access table have same PrintSpool number (Textbox1) ,then it should check for each record the AXAFRIENDS field value and display appropriate watermark during PRINT. Please can anyone make neccessary changes to make it working as desired.
I hope anyone can see this code and help me to make it working.
Thanks
I am using Excel as a frontend and Access as a backend. Now in the main form the user types in all the information about a customer and press Save. Suppose he stores 10 customers details so I am using PrintSpool Number . For those 10 records the printspool number will be save so that when the user press Print button then all those 10 Word document letters will get printed off. This works absolutely fine. Now I want to do the following checks in the code while printing:
It will make it easier on the watermark issue as it changes the below
First check
IF AXAFRIENDS = FLC use NO WATERMARK and END conditional (do not do second or third check)
IF FALSE move to second check
Second check
IF Team = LTC use LTC and END conditional (do not do third check)
IF Team = WINTERTHUR use WLUKCAP4 and END conditional (do not do third check)
IF FALSE move to third check
Third check
IF AXAFRIENDS = FRIENDS use PAP107 and END conditionals
IF AXAFRIENDS = DM use PAPSLD and END conditionals
AXAFRIENDS is the name of the field and the above conditions will result in different watermarks for each customer letter. My code doesn't work as required. Suppose 10 records in Access table have same PrintSpool number (Textbox1) ,then it should check for each record the AXAFRIENDS field value and display appropriate watermark during PRINT. Please can anyone make neccessary changes to make it working as desired.
Code:
Private Sub CommandButton3_Click()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim r As Long
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
"Data Source=J:\System1.mdb;"
Set rs = CreateObject("ADODB.Recordset")
strsql = "select * from tblmaster where Printpoolno='" & TextBox1.value & "'"
rs.Open strsql, cn
Do While Not rs.EOF
If rs.Fields("AXA/FRIENDS") = "FLC" Then
Call Merge_FLC
ElseIf rs.Fields("Team") = "LTC" Then
Call Merge_LTC
ElseIf rs.Fields("team") = "WINTERTHUR" Then
Call Merge_WINTERTHUR
ElseIf rs.Fields("AXA/FRIENDS") = "FRIENDS" Then
Call Merge_PAP107
ElseIf rs.Fields("AXA/FRIENDS") = "DM" Then
Call Merge_PAPSLD
End If
rs.MoveNext
Loop
MsgBox "The letters have been printed off."
rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
End Sub
Code:
Sub Merge_PAP107()
strworkbookname = "J:\WilliamsLea-AIMM\Critical Document Handling\ODH System.mdb"
If UserForm6.Caption = "FL WFI RETURN LETTER" Or UserForm6.Caption = "AWL WFI RETURN LETTER" Then
Call WordSetup("J:\test1\WFI Return Letter4.dot", "J:\System1\Test\PAP107.jpg", TextBox1.value, "FRIENDS")
Exit Sub
End If
If UserForm6.Caption = "FL CAPITA CDR" Or UserForm6.Caption = "AWL CAPITA CDR" Then
Call WordSetup("J:\test1\CAPITA Return Letter5.dot", "J:\Test\PAP107.jpg", TextBox1.value, "FRIENDS")
Exit Sub
End If
'Application.DisplayAlerts = True
End Sub
Sub Merge_PAPSLD()
strworkbookname = "J:\System1.mdb"
If UserForm6.Caption = "FL WFI RETURN LETTER" Or UserForm6.Caption = "AWL WFI RETURN LETTER" Then
Call WordSetup("J:\test1\WFI Return Letter4.dot", "J:\Test\PAPSLD.jpg", TextBox1.value, "DM")
Exit Sub
End If
If UserForm6.Caption = "FL CAPITA CDR" Or UserForm6.Caption = "AWL CAPITA CDR" Then
Call WordSetup("J:\test1\CAPITA Return Letter5.dot", "J:\Test\PAPSLD.jpg", TextBox1.value, "DM")
Exit Sub
End If
'Application.DisplayAlerts = True
End Sub
Sub Merge_LTC()
strworkbookname = "J:\System1.mdb"
If UserForm6.Caption = "FL WFI RETURN LETTER" Or UserForm6.Caption = "AWL WFI RETURN LETTER" Then
Call WordSetup("J:\test1\WFI Return Letter4.dot", "J:\Test\LTC.jpg", TextBox1.value, "LTC")
Exit Sub
End If
If UserForm6.Caption = "FL CAPITA CDR" Or UserForm6.Caption = "AWL CAPITA CDR" Then
Call WordSetup("J:\test1\CAPITA Return Letter5.dot", "J:\Test\LTC.jpg", TextBox1.value, "LTC")
Exit Sub
End If
'Application.DisplayAlerts = True
End Sub
Sub Merge_WINTERTHUR()
strworkbookname = "J:\System1.mdb"
If UserForm6.Caption = "FL WFI RETURN LETTER" Or UserForm6.Caption = "AWL WFI RETURN LETTER" Then
Call WordSetup("J:\test1\WFI Return Letter4.dot", "J:\Test\WLUKCAP4.jpg", TextBox1.value, "WINTERTHUR")
Exit Sub
End If
If UserForm6.Caption = "FL CAPITA CDR" Or UserForm6.Caption = "AWL CAPITA CDR" Then
Call WordSetup("J:\test1\CAPITA Return Letter5.dot", "J:\Test\WLUKCAP4.jpg", TextBox1.value, "WINTERTHUR")
Exit Sub
End If
End Sub
Sub Merge_FLC()
Application.DisplayAlerts = False
strworkbookname = "J:\System1.mdb"
If UserForm6.Caption = "FL WFI RETURN LETTER" Or UserForm6.Caption = "AWL WFI RETURN LETTER" Then
With CreateObject("Word.Application").Documents.Add("J:\TEST WFI Return Letter1.dot").MailMerge
.MainDocumentType = 0
.Destination = 1
.OpenDataSource _
Name:=strworkbookname, _
AddToRecentFiles:=False, _
Revert:=False, _
Format:=wdOpenFormatAuto, _
Connection:="Data Source=" & strworkbookname & ";Mode=Read", _
sqlstatement:="SELECT tmpU.* FROM (SELECT * FROM tblmaster where Printpoolno='" & TextBox1 & "' and [AXA/FRIENDS]='FLC'" & _
"UNION ALL SELECT * FROM tblmaster where Printpoolno='" & TextBox1 & "' and [AXA/FRIENDS]='FLC') tmpU ORDER BY tmpU.[PolicyNo];"
'sqlstatement:="SELECT * FROM `tblmaster` where Printpoolno='" & TextBox1.value & "' and [AXA/FRIENDS]=FLC"
.Execute
.Execute
.Parent.Close 0
End With
MsgBox "The letters have been printed off"
Exit Sub
End If
If UserForm6.Caption = "FL CAPITA CDR" Or UserForm6.Caption = "AWL CAPITA CDR" Then
With CreateObject("Word.Application").Documents.Add("J:\CAPITA Return Letter5.dot").MailMerge
.MainDocumentType = 0
.Destination = 1
.OpenDataSource _
Name:=strworkbookname, _
AddToRecentFiles:=False, _
Revert:=False, _
Format:=wdOpenFormatAuto, _
Connection:="Data Source=" & strworkbookname & ";Mode=Read", _
sqlstatement:="SELECT tmpU.* FROM (SELECT * FROM tblmaster where Printpoolno='" & TextBox1 & "' and [AXA/FRIENDS]='FLC'" & _
"UNION ALL SELECT * FROM tblmaster where Printpoolno='" & TextBox1 & "' and [AXA/FRIENDS]='FLC') tmpU ORDER BY tmpU.[PolicyNo];"
'sqlstatement:="SELECT * FROM `tblmaster` where Printpoolno='" & TextBox1.value & "'"
.Execute
.Parent.Close 0
End With
MsgBox "The letters have been printed off"
Exit Sub
End If
Application.DisplayAlerts = True
End Sub
Code:
Sub WordSetup(fnTemplate As String, fnBackGroundPic As String, txtbox As String, value As String)
On Error Resume Next
'MsgBox txtbox
Dim strworkbookname As String
strworkbookname = "J:\System1.mdb"
Set WordApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
'Launch a new instance of Word
Err.clear
On Error GoTo ErrorHandler
Set WordApp = CreateObject("Word.Application") 'New Word.Application
End If
WordApp.Documents.Add (fnTemplate)
Set WordDoc = WordApp.ActiveDocument
'WordApp.Visible = True
InsertHeaderLogo (fnBackGroundPic)
With WordDoc.MailMerge
.MainDocumentType = 0
.Destination = 1
.OpenDataSource _
Name:=strworkbookname, _
AddToRecentFiles:=False, _
Revert:=False, _
Format:=wdOpenFormatAuto, _
Connection:="Data Source=" & strworkbookname & ";Mode=Read", _
sqlstatement:="SELECT tmpU.* FROM (SELECT * FROM tblmaster where Printpoolno='" & txtbox & "' and [AXA/FRIENDS]='" & value & "'" & _
"UNION ALL SELECT * FROM tblmaster where Printpoolno='" & txtbox & "' and [AXA/FRIENDS]='" & value & "') tmpU ORDER BY tmpU.[PolicyNo];"
' sqlstatement:="SELECT * FROM `tblmaster` where Printpoolno='" & txtbox & "' and [AXA/FRIENDS]='" & value & "'"
'MsgBox sqlstatement
.Execute
'.Execute
.Parent.Close 0
End With
End If
ExitErrorHandler:
Exit Sub
ErrorHandler:
MsgBox "Error (" & Err.Number & ") : " & Err.Description & vbCrLf & vbCrLf & "Exiting procedure - WordSetUp", vbCritical
Resume ExitErrorHandler
End Sub
Public Function InsertHeaderLogo1(fnBackGroundPic As String)
Dim Shp As Word.Shape
On Error Resume Next
'Background Picture
If Not fnBackGroundPic = "" Then
Set WordLogo = WordApp.ActiveDocument.Bookmarks("BackGroundPicture").Range.InlineShapes.AddPicture(Filename:=fnBackGroundPic, LinkToFile:=False, SaveWithDocument:=True)
With WordLogo
.ConvertToShape
.LockAspectRatio = msoTrue
'.Range.ShapeRange.WrapFormat.Type = wdWrapBehind
.Range.ShapeRange.WrapFormat.AllowOverlap = True
.Range.ShapeRange.WrapFormat.Side = wdWrapBoth
.Range.ShapeRange.WrapFormat.Type = 3
.PictureFormat.ColorType = msoPictureGrayscale
'Debug.Print .Title
.PictureFormat.Contrast = 0.4
.PictureFormat.Brightness = 0.8
.Width = 538.58
.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Range.ParagraphFormat.Alignment = wdAlignParagraphJustifyLow
.Range.ParagraphFormat.LeftIndent = WordApp.CentimetersToPoints(-1#)
.Range.ShapeRange.Align msoAlignCenters, True
.Range.ShapeRange.Align msoAlignMiddles, True
.Range.ParagraphFormat.SpaceBeforeAuto = False
.Range.ParagraphFormat.SpaceAfterAuto = False
End With
Else
MsgBox "hELLO"
End If
End Function
I hope anyone can see this code and help me to make it working.
Thanks
Last edited: