If IsNull(QueryA!CheckTitle) = False Then .Cell(1, 1).Range.Text = QueryA!CheckTitle
           If IsNull(QueryA!CheckOutcome) = False Then .Cell(1, 2).Range.Text = QueryA!CheckOutcome
           If IsNull(QueryA!CheckComments) = False Then .Cell(1, 2).Range.End.InsertBefore vbCr & QueryA!CheckComments
           End With

With .Cell(1, 1).Range
If IsNull(QueryA!CheckTitle) = True Then
Else
.InsertAfter QueryA!CheckTitle
End If
End With
With .Cell(1, 2).Range
If IsNull(QueryA!CheckOutcome) = True Then
Else
.InsertAfter QueryA!CheckOutcome & vbCr
End If
If IsNull(QueryA!CheckComments) = True Then
Else
.InsertAfter QueryA!CheckComments
End If
'End with for Cell
End With
'End with for Tables
End With

If IsNull(QueryA!CheckTitle) = False Then
Set wdRng = .Characters.Last
With wdRng
.InsertAfter vbCr
End With

Private Sub but_Unsatisfactory_Click()
Dim QueryA As DAO.Recordset
Dim QueryB As DAO.Recordset
Dim dbs As DAO.Database
Dim strSQLA As String, strSQLB As String
Dim DA As String, DAX As String
Dim Variable As String
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdRng As Word.Range
Dim Tbl As Word.Table
Dim WordHeaderFooter As HeaderFooter
Dim myrange As Range
 
If Forms!frm_Assess!lst_Referrals.Column(5) <> "" Then
Set dbs = CurrentDb
DA = Forms!frm_Assess!txt_DA
DAX = """" & DA & """"
 
'Query SQL String for Checks
strSQLA = "SELECT tbl_DA.DAID, tbl_DA.[DA No], tbl_DAConCheck.CheckTitle, tbl_DAConCheck.CheckOutcome, tbl_DAConCheck.CheckComments, tbl_DAConCheck.ConditionCategory, tbl_DAConCheck.Order " & _
"FROM tbl_DA INNER JOIN tbl_DAConCheck ON tbl_DA.DAID = tbl_DAConCheck.DAID " & _
"WHERE (((tbl_DA.[DA No])=" & DAX & ") AND ((tbl_DAConCheck.CheckOutcome)<> ""Invisible"")) " & _
"ORDER BY tbl_DAConCheck.ConditionCategory, tbl_DAConCheck.Order;"
'Query SQL String for RAI
strSQLB = "SELECT tbl_DA.DAID, tbl_DA.[DA No], tbl_DAConCheck.RAIOutcome, tbl_DAConCheck.RAITitle, tbl_DAConCheck.RequestAdditionalInformation, tbl_DAConCheck.ConditionCategory, tbl_DAConCheck.Order " & _
"FROM tbl_DA INNER JOIN tbl_DAConCheck ON tbl_DA.DAID = tbl_DAConCheck.DAID " & _
"WHERE (((tbl_DA.[DA No]) = " & DAX & ") And ((tbl_DAConCheck.RAIOutcome) = True)) " & _
"ORDER BY tbl_DAConCheck.ConditionCategory, tbl_DAConCheck.Order;"
'Set Recordsets
Set QueryA = dbs.OpenRecordset(strSQLA)
Set QueryB = dbs.OpenRecordset(strSQLB)
'Open Word
  Set wdApp = CreateObject("Word.Application")
  With wdApp
    .Visible = True
    .ScreenUpdating = False
'Create a new document
    Set wdDoc = .Documents.Add
    With wdDoc
 
'Basic Document Format
      With .Styles(wdStyleNormal)
        .Font.Name = "Arial"
        .Font.Size = 11
        With .ParagraphFormat
          .LineSpacingRule = wdLineSpaceSingle
          .SpaceAfter = 0
          .SpaceBefore = 0
        End With
      End With
'Title/IntroPage
 'Insert Gray Table
 Set wdTbl = .Tables.Add(Range:=.Range.Characters.Last, NumRows:=1, NumColumns:=1, _
        DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed)
      With wdTbl
        .Style = "Table Grid"
        .ApplyStyleHeadingRows = True
        .ApplyStyleLastRow = False
        .ApplyStyleFirstColumn = True
        .ApplyStyleLastColumn = False
        .ApplyStyleRowBands = True
        .ApplyStyleColumnBands = False
        With .Cell(1, 1).Range
          .Shading.BackgroundPatternColor = -603937025
          .InsertAfter "Council Report Summary" & vbCr & _
            "The proposed development application does not comply with the requirements of Council's relevant policies."
          .Paragraphs.First.Range.Style = wdStyleStrong
        End With
      End With
 
      'Make space for query insertion
      .Range.InsertAfter vbCr & vbCr & vbCr & vbCr
      Set wdRng = .Paragraphs.Last.Previous.Previous.Range
 
      'Insert & Format Query
 
      With wdRng
      .InsertBefore QueryA!ConditionCategory
      .Style = wdStyleStrong
      .Paragraphs.Alignment = wdAlignParagraphCenter
      End With
 
    'Checks Loop Start
Variable = QueryA!ConditionCategory
Do While Not QueryA.EOF
'Check if Check Category is the same as previous if not type new category
If Variable <> QueryA!ConditionCategory Then
.Range.InsertAfter vbCr
Set wdRng = .Paragraphs.Last.Previous.Range
'Insert & format Query
With wdRng
.InsertBefore vbCr & vbCr & QueryA!ConditionCategory & vbCr
.Style = wdStyleStrong
.Paragraphs.Alignment = wdAlignParagraphCenter
End With
End If
 
'Make sure check has a title and insert table fill in with notes
If IsNull(QueryA!CheckTitle) = False Then
Set wdRng = .Characters.Last
With wdRng
.InsertAfter vbCr
End With
Set wdTbl = .Tables.Add(Range:=.Range.Characters.Last, NumRows:=1, NumColumns:=2, _
        DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed)
      With wdTbl
        .Style = "Table Grid"
        .ApplyStyleHeadingRows = True
        .ApplyStyleLastRow = False
        .ApplyStyleFirstColumn = True
        .ApplyStyleLastColumn = False
        .ApplyStyleRowBands = True
        .ApplyStyleColumnBands = False
 
With .Cell(1, 1).Range
If IsNull(QueryA!CheckTitle) = True Then
Else
.InsertAfter QueryA!CheckTitle
End If
End With
With .Cell(1, 2).Range
If IsNull(QueryA!CheckOutcome) = True Then
Else
.InsertAfter QueryA!CheckOutcome & vbCr
End If
If IsNull(QueryA!CheckComments) = True Then
Else
.InsertAfter QueryA!CheckComments
End If
'End with for Cell
End With
'End with for Tables
End With
End If
Variable = QueryA!ConditionCategory
    QueryA.MoveNext
    Loop
 
    QueryA.Close
    'Checks Loop Ends
 'Save the document
.SaveAs CurrentProject.Path & "\TestDoc.doc"
 
'end with doc
End With
    .ScreenUpdating = True
'end with objword
  End With
Else
MsgBox "Referal Completed Date Required", 0, "Date Required"
End If
Set wdRng = Nothing: Set wdTbl = Nothing: Set wdDoc = Nothing: Set wdApp = Nothing