以下代码将运行到标记的行。然后，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
最佳答案
关注眼前的问题 ---“无法打开 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 View 中进行测试。
但是，除非您解决了 Word 文档的只读问题，否则这些 Access 查询问题并不重要。
为了跟进可见性与只读的问题，我的代码打开了 Word 文档并修改了它们，当我包含这两个更改中的一个或两个时，没有抛出错误:
appCur.Visible = False
和
Set docCur = appCur.Documents.Open(FileName:=strDocPath & strDocName, _
ReadOnly:=False, Visible:=False)
关于ms-access - 无法使用 vba 打开 Word 文件进行编辑，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/12338076/