使用vba无法打开用于编辑的字文件

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字符串是非常有用的，这样你就可以直接检查你要求数据库引擎运行的完整语句......查看它而不是依靠你的想象力猜测它的样子。当它失败时，您可以复制立即窗口中的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