440 automation error is the exact error message.
Full vba shown below.
Code:
Private Sub Command7_Click()
On Error GoTo Error_Handle
Dim FSO
Dim sFile As String
Dim sDFolder As String
Dim sNewFile As String
Dim answer As Integer
DoCmd.SetWarnings False
DoCmd.OpenQuery "update_RAMS_issue", acViewNormal, acEdit
If Nz(Me.lstFileList, "") = "" Then
MsgBox "pick a template."
Me.Refresh
Me.Requery
Exit Sub
End If
If IsNull([txtProject]) Or [txtProject] = "" Then
MsgBox "Please write a project."
Me.Refresh
Me.Requery
Exit Sub
End If
Dim xl As Object
'Step 1: Start Excel, then open the target workbook.
Set xl = CreateObject("Excel.Application")
xl.Workbooks.Open ("\\SERVER\general\Documents\!Management\VBA_Templates_do_not_modify\HAZARDS\HAZARDS.xlsm")
xl.activeworkbook.refreshall
'File Name to Copy
sFile = Me.lstFileList
' New File Name
sNewFile = "RAM_" & Me.Site_Name & "_" & Me.Site_ID & "_" & Me.RAMS_ISSUE & ".docx"
'destination folder path
sDFolder = "\\SERVER\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(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) Then
FSO.CopyFile (sFile), sDFolder, True
Else
MsgBox "Specified File Already Exists In The Destination Folder", vbExclamation, "File Already Exists"
Exit Sub
End If
'-----------------CREATE FILE END-----------------
'-----------------AMMEND FILE-----------------
'-----------------Set up word document to use recordset ------------------
Dim wrdApp As Object
Dim wrdDoc As Object
Dim filepath As String
Dim docFile As String
'''''''''''''' Dim rst As DAO.Recordset
'-----------------Set up word document to use recordset 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;"
Dim rst As DAO.Recordset
Set rst = db.OpenRecordset(sSql)
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 = "test"
wrdApp.ActiveDocument.Bookmarks("User_Long").Select
wrdApp.Selection.Text = "test"
wrdApp.ActiveDocument.Bookmarks("User_Long_title").Select
wrdApp.Selection.Text = " - Systems Manager"
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")
wrdApp.ActiveDocument.Bookmarks("CompanyAndProject").Select
wrdApp.Selection.Text = rst("company_name") & "_" & Me.txtProject
wrdApp.ActiveDocument.Bookmarks("Project").Select
wrdApp.Selection.Text = Me.txtProject
wrdApp.ActiveDocument.Bookmarks("Project1").Select
wrdApp.Selection.Text = Me.txtProject
'Dim test As String
'test = Me.Project
'Debug.Print test
wrdApp.ActiveDocument.Save
wrdApp.ActiveDocument.Close
End With
' Set rst = Nothing
Application.Echo True
DoCmd.SetWarnings True
MsgBox "RAMS are saved: " & sDFolder, vbInformation, "Done!"
Me.Refresh
Me.Requery
'---------------------------------------------------RISKS-----------------------------------------
'------------------------------paste path to excel-----------------------------------
xl.worksheets("PasteSpecial").Activate
xl.Range("i1").Value = sNewFile
'------------------------------paste path to excel-----------------------------------
'Step 2: Make Excel visible
' xl.Visible = True
'xl.Run "ThisWorkbook.datarefresh"
xl.Run "ThisWorkbook.BetterExcelDataToWord"
'Step 4: Close and save the workbook, then close Excel
'xl.activeworkbook.Close (True)
'xl.Quit
'Step 5: Memory Clean up.
'Set xl = Nothing
'---------------------------------------------------RISKS-----------------------------------------
Exit Sub
Error_Handle:
MsgBox "Oops, an error has occured." & vbCrLf & vbCrLf & "Error Code : " & Err.Number & " , " & Err.Description
End Sub