Question

以下代码运行到标记的行。 Word然后显示一个文件被锁定以进行编辑/打开只读提示。我需要能够编辑文档（这是代码的全部内容）。

对于非常长的代码阻止感到抱歉 - 我觉得显示所有内容非常重要，以便更容易找到问题。

对于多个记录集，代码也很笨拙，如果有人有任何更好的想法会喜欢这里。

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

专注于眼前问题---“无法打开word文件进行编辑”。

我创建了一个文件夹C:\share\testdocs\，并添加了Word文档。下面的代码示例使用常量作为文件夹名称。我想要一个简单的测试，所以摆脱了FileDialog。我也丢弃了所有记录集代码。

打开Word文档时我使用了Visible：= True。我不明白为什么你可以看到Word应用程序，但单个文档不可见。无论逻辑是什么，我选择让它们可见，这样我就能观察到内容的变化。

我使用Access 2007进行了测试，它可以正常运行。如果它不起作用，请仔细检查文件夹和目标文档的当前用户的文件系统权限。

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

假设您能够通过只读问题，我认为您面临更多挑战。您的SELECT陈述对我来说非常可疑......

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

例如，如果strDocName包含“ temp.docx ”，则strSQL将包含此文字......

Select Distinct Item From IHR where filename istemp.docx

这不是有效的SELECT语句。我想你可能需要更像这样的东西......

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

Item是一个保留字，因此我将其括在方括号中以避免混淆数据库引擎。使用等于运算符（=）而不是“is”进行字符串比较。

对Debug.Print strSQL字符串非常有用，这样您就可以直接检查要求db引擎运行的已完成语句...查看它而不是依赖于您的想象力猜猜看起来像什么。当它失败时，您可以从立即窗口复制Debug.Print输出并将其粘贴到新查询的SQL视图中进行测试。

但是，在您可以通过Word文档的只读问题之前，这些Access查询问题无关紧要。

为了跟进可见性与只读的问题，我的代码打开Word文档并修改它们，而不会在我包含这两个更改中的一个或两个时抛出错误：

appCur.Visible = False

和

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

Answer 2

我只读了一个打开文件的问题。您可以尝试输入以下代码：

appcur.ActiveWindow.View.ReadingLayout = False

无法使用vba从访问权限打开word文件进行编辑

2 个答案: