title: Cannot open word file for editing from access using vba
body: <p>The following code runs as far as the marked line. Word then shows a file locked for editing/ open read only prompt. I need to be able to edit the document (that is the whole point of the code).</p>
  
  <p>Sorry for incredibly long code block - I felt it was important to show everything so that it was easier to find the problem.</p>
  
  <p>The code is also kind of clunky with the multiple recordsets, if anyone has any better ideas would love to here them.</p>
  
  <pre><code>Option Explicit
  Option Compare Database
  
  Sub InputSafetyData()
  
  Dim dbCur As Database
  
  Dim appCur As Word.Application
  Dim docCur As Word.Document
  Dim dlgCur As FileDialog
  
  Dim rngCcCur As Range
  
  Dim varDlgCur As Variant
  
  Dim strDocName As String
  Dim strDocPath As String
  Dim strSQL As String
  
  Dim rsIt As DAO.Recordset
  Dim rsHc As DAO.Recordset
  Dim rsHz As DAO.Recordset
  Dim rsPr As DAO.Recordset
  
  
  Dim strHc As String
  Dim strHz As String
  Dim strPr As String
  
  Set dbCur = CurrentDb()
  Set dlgCur = Application.FileDialog(msoFileDialogFolderPicker)
  
  With dlgCur
      .AllowMultiSelect = False
      If .Show &lt;&gt; -1 Then End
      varDlgCur = .SelectedItems(1)
  End With
  
  strDocPath = CStr(varDlgCur) &amp; "\"
  strDocName = Dir(strDocPath &amp; "*.docx")
  
  Set appCur = New Word.Application
      appCur.Visible = True
  Set dlgCur = Nothing
  
  Do While strDocName &lt;&gt; ""
  
      'Runs as far here
      Set docCur = appCur.Documents.Open(FileName:=strDocPath &amp; strDocName, ReadOnly:=False, Visible:=False)
  
      If docCur.ReadOnly = False Then
  
          Set rngCcCur = docCur.ContentControls(6).Range
          rngCcCur = ""
          appCur.ActiveDocument.Tables.Add Range:=rngCcCur, NumRows:=1, NumColumns:=4
          With rngCcCur.Tables(0)
              If .Style &lt;&gt; "Table Grid" Then
                  .Style = "Table Grid"
              End If
              .ApplyStyleHeadingRows = True
              .ApplyStyleLastRow = False
              .ApplyStyleFirstColumn = True
              .ApplyStyleLastColumn = False
              .ApplyStyleRowBands = True
              .ApplyStyleColumnBands = False
              .Style = "Light Shading"
              .AutoFitBehavior wdAutoFitWindow
              .Cell(1, 1).Range.InsertAfter "Item"
              .Cell(1, 2).Range.InsertAfter "Hazcard"
              .Cell(1, 3).Range.InsertAfter "Hazard"
              .Cell(1, 4).Range.InsertAfter "Precaution"
  
              'select distinct item based on filename
              strSQL = "Select Distinct Item From IHR where filename is"
              strSQL = strSQL &amp; strDocName
              Set rsIt = dbCur.OpenRecordset(strSQL, dbOpenDynaset)
              If Not (rsIt.BOF And rsIt.EOF) = True Then
                  While Not rsIt.EOF
                      .Rows.Add
                      .Cell(rsIt.AbsolutePosition + 2, 1).Range.InsertAfter rsIt.Fields(1).Value
                      'select distinct hazcard based on item
                      strSQL = "Select Distinct Hazcard From IHR where item is"
                      strSQL = strSQL &amp; rsIt.Fields(1).Value
                      Set rsHc = dbCur.OpenRecordset(strSQL, dbOpenDynaset)
                      If Not (rsHc.BOF And rsHc.EOF) = True Then
                          While Not rsHc.EOF
                              strHc = strHc &amp; " " &amp; rsHc.Fields(2).Value
                              .Cell(rsIt.AbsolutePosition + 2, 2).Range.InsertAfter strHc
                              rsHc.MoveNext
                          Wend
                      End If
                      rsHc.Close
                      Set rsHc = Nothing
  
                      'select distinct hazard based on item
                      strSQL = "Select Distinct Hazard From IHR where item is"
                      strSQL = strSQL &amp; rsIt.Fields(1).Value
                      Set rsHz = dbCur.OpenRecordset(strSQL, dbOpenDynaset)
                      If Not (rsHz.BOF And rsHz.EOF) = True Then
                          While Not rsHz.EOF
                          strHc = strHz &amp; " " &amp; rsHz.Fields(2).Value
                              .Cell(rsIt.AbsolutePosition + 2, 3).Range.InsertAfter strHz
                              rsHz.MoveNext
                          Wend
                      End If
                      rsHz.Close
                      Set rsHz = Nothing
  
                      'select distinct precaution based on item
                      strSQL = "Select Distinct Precaution From IHR where item is"
                      strSQL = strSQL &amp; rsIt.Fields(1).Value
                      Set rsPr = dbCur.OpenRecordset(strSQL, dbOpenDynaset)
                      If Not (rsPr.BOF And rsPr.EOF) = True Then
                          While Not rsPr.EOF
                              strPr = strPr &amp; " " &amp; rsPr.Fields(4).Value
                              .Cell(rsIt.AbsolutePosition + 2, 4).Range.InsertAfter strPr
                              rsPr.MoveNext
                          Wend
                      End If
                      rsPr.Close
                      Set rsPr = Nothing
  
                      rsIt.MoveNext
                  Wend
              End If
          End With
          rsIt.Close
          Set rsIt = Nothing
      Debug.Print (docCur.Name)
      docCur.Save
      End If
      docCur.Close
      Set docCur = Nothing
      strDocName = Dir
  Loop
  
  Set appCur = Nothing
  
  End Sub
  </code></pre>