I’ve been working on this for a few weeks now. Almost complete, some final issues. (*this is without other code I was working on recently to add risks; if i get that working it wont be in the same code)
Using the below it will copy a template document and rename it, find bookmarks within it and add fields to the bookmarks from the recordsource.
I'm not handling word properly but can't figure out how to. The word document appears to be closed but sometimes i get the error its already open. Other times it will open in web view and ask if i want to save changes when closed. (if I click yes everything in the document is then as it should be and in the correct view.)
Ive messed about with changing the view to normal, hiding visability of the word app and closing the document in VBA.
If I try to close it it says one is not open (probably because im trying to close active document and its not active?). The code probably needs to also save too.
If theres any criticism about the code I'd love to hear it, all help is appreciated. Once this part is done and the code is reliable people can start to use it.
Thanks.
(I will keep working on this and updating)
Code:
'-----------------CREATE FILE-----------------
Private Sub Command93_Click()
Dim FSO
Dim sFile As String
Dim sSFolder As String
Dim sDFolder As String
Dim sNewFile As String
Dim answer As Integer
DoCmd.SetWarnings False
DoCmd.OpenQuery "update_RAMS_issue", acViewNormal, acEdit
'File Name to Copy
sFile = "RAM_Template.docx"
' New File Name
sNewFile = "RAM_" & Me.Site_Name & "_" & Me.Site_ID & "_" & Me.RAMS_ISSUE & ".docx"
' source folder path
sSFolder = "\\*****\general\*****Documents\!Managment\VBA_Templates_do_not_modify\"
'destination folder path
sDFolder = "\\*****\general\RAMS\RAM_RAMS\" & sNewFile
Application.Echo False
'-------msgbox for rams-----
answer = MsgBox("Make RAMS for " & Me.Site_Name & "?", vbYesNo + vbQuestion, "Empty Sheet")
If answer = vbYes Then
Else
Exit Sub
End If
'-------msgbox for rams end-----
'Create Object
Set FSO = CreateObject("Scripting.FileSystemObject")
'Checking If File Is Located in the Source Folder
If Not FSO.FileExists(sSFolder & sFile) Then
MsgBox "Specified File Not Found", vbInformation, "Not Found"
'Copying If the Same File is Not Located in the Destination Folder
ElseIf Not FSO.FileExists(sDFolder & sFile) Then
FSO.CopyFile (sSFolder & sFile), sDFolder, True
Else
MsgBox "Specified File Already Exists In The Destination Folder", vbExclamation, "File Already Exists"
End If
'-----------------CREATE FILE END-----------------
'-----------------AMMEND FILE-----------------
'-----------------Set up word document to use recordset ------------------
Dim wrdApp As New Word.Application
Dim wrdDoc As Word.Document
Dim filepath As String
Dim docFile As String
Dim rst As DAO.Recordset
'-----------------Set up word document to use recordset end------------------
' --------------------------
'-----------------define bookmark variables as range -----------------
Dim Date_Compiled As Word.Bookmarks
Dim Doc_No As Word.Bookmarks
Dim hospital_details As Word.Bookmarks
Dim site_details As Word.Bookmarks
Dim Site_Name1 As Word.Bookmarks
Dim Site_Name_Postcode As Word.Bookmarks
Dim User As Word.Bookmarks
Dim User_Long As Word.Bookmarks
Dim Date_Compiled1 As Word.Bookmarks
Dim Date_Compiled3 As Word.Bookmarks
Dim User_Long_title As Word.Bookmarks
Dim site_details1 As Word.Bookmarks
Dim Doc_No1 As Word.Bookmarks
'-----------------define bookmark variables as range end------------------
'------------------ define query -----------------------------
Dim db As Database
Dim sSql As String
Set db = CurrentDb
sSql = "SELECT SiteT.Site_ID, SiteT.Site_Name, SiteT.Asset_Type, SiteT.Address_1, SiteT.Address_2, SiteT.Address_3, SiteT.Postcode, ClientT.Company_Name, ClientT.Company_ID, HospitalT.Hospital_Name, HospitalT.Hospital_Postcode, HospitalT.Hospital_Address, HospitalT.Hospital_Telephone, SiteT.lat, SiteT.long, SiteT.Rams_Issue "
sSql = sSql & "FROM HospitalT INNER JOIN (ClientT INNER JOIN SiteT ON ClientT.Company_ID = SiteT.Site_Owner) ON HospitalT.Hospital_ID = SiteT.Hospital_ID "
sSql = sSql & "WHERE [SiteT].[Site_ID] = " & Me.Site_ID & " "
sSql = sSql & "ORDER BY SiteT.Site_Name;"
Set rst = db.OpenRecordset(sSql)
Debug.Print Hospital_Address
filepath = sDFolder
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = False
Set wrdDoc = wrdApp.Documents.Open(filepath)
With wrdDoc
wrdApp.ActiveDocument.Bookmarks("Date_Compiled").Select
wrdApp.Selection.Text = Date
wrdApp.ActiveDocument.Bookmarks("Doc_No").Select
wrdApp.Selection.Text = rst("Site_ID") & "_" & rst("Rams_Issue")
wrdApp.ActiveDocument.Bookmarks("hospital_details").Select
wrdApp.Selection.Text = rst("Hospital_Name") & vbCrLf & rst("Hospital_Address") & vbCrLf & rst("Hospital_Postcode") & vbCrLf & rst("Hospital_Telephone")
wrdApp.ActiveDocument.Bookmarks("site_details").Select
wrdApp.Selection.Text = rst("Site_Name") & vbCrLf & rst("Address_1") & vbCrLf & rst("Address_2") & vbCrLf & rst("Address_3") & vbCrLf & rst("Postcode")
wrdApp.ActiveDocument.Bookmarks("Site_Name1").Select
wrdApp.Selection.Text = rst("Site_Name")
wrdApp.ActiveDocument.Bookmarks("Site_Name_Postcode").Select
wrdApp.Selection.Text = rst("Site_Name") & vbCrLf & rst("Postcode")
wrdApp.ActiveDocument.Bookmarks("User").Select
wrdApp.Selection.Text = "NA"
wrdApp.ActiveDocument.Bookmarks("User_Long").Select
wrdApp.Selection.Text = "NAME"
wrdApp.ActiveDocument.Bookmarks("User_Long_title").Select
wrdApp.Selection.Text = "NAME & TITLE"
wrdApp.ActiveDocument.Bookmarks("Date_Compiled1").Select
wrdApp.Selection.Text = Date
wrdApp.ActiveDocument.Bookmarks("Date_Compiled3").Select
wrdApp.Selection.Text = Date
wrdApp.ActiveDocument.Bookmarks("Doc_No1").Select
wrdApp.Selection.Text = rst("Site_ID") & "_" & rst("Rams_Issue")
wrdApp.ActiveDocument.Bookmarks("Doc_No2").Select
wrdApp.Selection.Text = rst("Site_ID") & "_" & rst("Rams_Issue")
wrdApp.ActiveDocument.Bookmarks("site_details1").Select
wrdApp.Selection.Text = rst("Site_Name") & vbCrLf & rst("Address_1") & vbCrLf & rst("Address_2") & vbCrLf & rst("Address_3") & vbCrLf & rst("Postcode")
End With
Set rst = Nothing
Application.Echo True
DoCmd.SetWarnings True
MsgBox "RAMS are saved: " & sDFolder, vbInformation, "Done!"
End Sub