Close word document that is not active.

[Homegrownandy]

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)

'-----------------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

[Homegrownandy]

Update:

This is helping:

wrdApp.ActiveDocument.Save
wrdApp.ActiveDocument.Close

earlier because of some testing I must have had a few instances of word open that i couldnt see. (I probably still do) seems to be causeing issues.

some issues are still happening sometimes. It will update the screen to add the fields sometimes rather than doing it hidden.