1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101
|
Public Sub CreateMed(word_flag As Boolean, pdf_flag As Boolean, Student_Name As String, center As String, Date_From As String, Date_To As String, Invoice As String)
Dim recv As Recordset
Dim Reci As Recordset
Dim Dbv As Database
Dim document As String
Dim Reference As String
Dim Pdfdoc As String
Dim NewPdfdoc As String
Dim checkup As String
Dim Model As String
'Reference Current Database
Set Dbv = DBEngine.Workspaces(0).Databases(0)
'Open Recordset Zcontrol and get 1st record
Set recv = Dbv.OpenRecordset("SQL_Zcontrol", , dbReadOnly)
recv.FindFirst "DB_Year > 0"
If recv.EOF Then GoTo exit_create_Travel
Reference = Trim(Invoice) & Trim(recv![Inv_pre])
If IsNull(Reference) Then Reference = " "
'Open Recordset Installations and get 1st record
Set Reci = Dbv.OpenRecordset("SQL_Installation_Lines", , dbReadOnly)
Reci.FindFirst "Install_Nr > 0"
If Reci.EOF Then GoTo exit_create_Travel
Model = Trim(recv![Model_Folder]) & Trim(recv![Medical_Model_Name])
checkup = Dir(Model, vbHidden)
If checkup = "" Then
checkup = MsgBox("Model file " & Model & " missing. Operation not possible", vbCritical, "Oops")
GoTo exit_create_Travel
End If
' instantiate the word application and create a new
' document based upon the supplied template
Set m_objWord = New Word.Application
Set m_objDoc = m_objWord.Documents.Add(Model, , , True)
' insert the Student details
InsertTextAtBookMark "Student_Name", Student_Name
InsertTextAtBookMark "Center", center
InsertTextAtBookMark "Arrival_Date", Date_From
InsertTextAtBookMark "Departure_Date", Date_To
InsertTextAtBookMark "reference", Reference
'Save File required before closing to prevent a window at exit
document = Trim(recv![Generated_Folder]) & Student_Name & "_Medical.DOC"
'Insert Filename in header
InsertTextAtBookMark "Filename", Student_Name & "_Medical.DOC"
On Error Resume Next
Kill document
m_objDoc.SaveAs Filename:=document
Select Case True
Case pdf_flag
m_objDoc.Application.Run ("Module1.Converttopdf_Silent")
Pdfdoc = Trim(recv![Generated_Folder]) & Student_Name & "_Medical.PDF"
NewPdfdoc = Trim(recv![Generated_Acrobat_Folder]) & Student_Name & "_Medical.PDF"
FileCopy Pdfdoc, NewPdfdoc
Kill Pdfdoc
PhWnd = OpenProgram(NewPdfdoc, 0)
Case word_flag
'Set word in visible state
m_objWord.Visible = True
'Activate Word and printpreview the created document
m_objDoc.Activate
'Print Preview the document
m_objDoc.PrintPreview
'Wait for printpreview window closed
Do While m_objWord.PrintPreview = True
Loop
End Select
'Close all words instances
m_objDoc.ActiveWindow = False
On Error Resume Next
m_objDoc.Close
recv.Close
Reci.Close
On Error Resume Next
m_objWord.Quit
Set m_objDoc = Nothing
exit_create_Travel:
End Sub |
Partager