Hi guys
I am writing the following code but it keeps giving the above error message and I need to press OK many times and then it does print the document letters.
Can anyone please help me in this?
I am writing the following code but it keeps giving the above error message and I need to press OK many times and then it does print the document letters.
Can anyone please help me in this?
Code:
Private Sub CommandButton3_Click()
Call Merge_LTC
End sub
Code:
Sub Merge_LTC()
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:\WilliamsLea-AIMM\Critical Document Handling\Master Templates\test1\WFI Return Letter4.dot", "J:\WilliamsLea-AIMM\Critical Document Handling\New Critical Document Handling System\Test\LTC.jpg", TextBox1.value, "LTC")
Exit Sub
End If
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:\WilliamsLea-AIMM\Critical Document Handling\ODH System.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 * FROM `tblmaster` where Printpoolno='" & txtbox & "' and [TEAM]='" & value & "'"
'MsgBox sqlstatement
.Execute
'.Execute
.Parent.Close 0
End With
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