Cannot open word file for editing from access using vba

Question

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).

Sorry for incredibly long code block - I felt it was important to show everything so that it was easier to find the problem.

The code is also kind of clunky with the multiple recordsets, if anyone has any better ideas would love to here them.

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 <> -1 Then End
    varDlgCur = .SelectedItems(1)
End With

strDocPath = CStr(varDlgCur) & "\"
strDocName = Dir(strDocPath & "*.docx")

Set appCur = New Word.Application
    appCur.Visible = True
Set dlgCur = Nothing

Do While strDocName <> ""

    'Runs as far here
    Set docCur = appCur.Documents.Open(FileName:=strDocPath & 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 <> "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 & 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 & 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 & " " & 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 & 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 & " " & 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 & 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 & " " & 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

Answer 1

Focus on the immediate problem --- "Cannot open word file for editing".

I created a folder, C:\share\testdocs\, and added Word documents. The code sample below uses a constant for the folder name. I wanted a simple test, so got rid of FileDialog. I also discarded all the recordset code.

I used Visible:=True when opening the Word documents. I didn't understand why you have the Word application visible, but the individual documents not visible. Whatever the logic for that, I chose to make them visible so I could observe the content changes.

I tested this with Access 2007, and it works without errors. If it doesn't work for you, double-check the file system permissions for the current user for both the folder and the target documents.

Public Sub EditWordDocs()
Const cstrFolder As String = "C:\share\testdocs\"
Dim appCur As Word.Application
Dim docCur As Word.Document
Dim strDocName As String
Dim strDocPath As String
Dim strMsg As String

On Error GoTo ErrorHandler

strDocPath = cstrFolder
strDocName = Dir(strDocPath & "*.docx")

Set appCur = New Word.Application
appCur.Visible = True

Do While strDocName <> ""
    Debug.Print "strDocName: " & strDocName
    Set docCur = appCur.Documents.Open(FileName:=strDocPath & strDocName, _
        ReadOnly:=False, Visible:=True)
    Debug.Print "FullName: " & docCur.FullName
    Debug.Print "ReadOnly: " & docCur.ReadOnly
    ' add text to the document ... '
    docCur.content = docCur.content & vbCrLf & CStr(Now)
    docCur.Close SaveChanges:=wdSaveChanges
    Set docCur = Nothing
    strDocName = Dir
Loop

ExitHere:
    On Error Resume Next
    appCur.Quit SaveChanges:=wdDoNotSaveChanges
    Set appCur = Nothing
    On Error GoTo 0
    Exit Sub

ErrorHandler:
    strMsg = "Error " & Err.Number & " (" & Err.Description _
        & ") in procedure EditWordDocs"
    MsgBox strMsg
    Debug.Print strMsg
    GoTo ExitHere
End Sub

Assuming you're able to get past the read-only problem, I think you have more challenges ahead. Your SELECT statements look highly suspicious to me ...

'select distinct item based on filename '
strSQL = "Select Distinct Item From IHR where filename is"
strSQL = strSQL & strDocName

For example, if strDocName contains "temp.docx", strSQL will contain this text ...

Select Distinct Item From IHR where filename istemp.docx

That is not a valid SELECT statement. I think you may need something more like this ...

SELECT DISTINCT [Item] FROM IHR WHERE filename = 'temp.docx'

Item is a reserved word, so I enclosed it in square brackets to avoid confusing the db engine. Use the equality operator (=) instead of "is" for your string comparisons.

It is extremely useful to Debug.Print your strSQL string, so that you may directly examine the completed statement you're asking the db engine to run ... view it instead of relying on your imagination to guess what it looks like. And when it fails, you can copy the Debug.Print output from the Immediate window and paste it into SQL View of a new query for testing.

However, those Access query issues don't matter until you can get past the read-only issue with your Word documents.

To follow up on the issue of visibility vs. read-only, my code opened the Word documents and modified them without throwing errors when I included either or both of these two changes:

appCur.Visible = False

and

Set docCur = appCur.Documents.Open(FileName:=strDocPath & strDocName, _
    ReadOnly:=False, Visible:=False)

Answer 2

I had the same problem with a file opened read only. You can try putting in the following code:

appcur.ActiveWindow.View.ReadingLayout = False