excel - 不可预测的错误 VBA microsoft word 将注释和文本复制到 excel

问题描述

我尝试制作一个宏，它可以获取 word 文档中的所有评论，根据评论文本进行过滤，然后将它们与注释中的相关文本一起插入到 excel 中。

我反复尝试了每一步，并设法复制了评论并将想要的结果粘贴到同一个 word 文档中。然后我设法通过添加列和注释来操作 excel。

当我将 excel 部分与评论提取部分集成时，一切都崩溃了。这些错误是invalid procedure call针对rightParPos = InStr(leftParPos, comment, ")")我有一段时间没有接触过的行，所以我尝试输出参数......这导致了一个完全不同的错误 -categories数组的索引错误为categoryCount0，这也很奇怪。之后，我尝试删除字符串中的一个奇怪字符，然后我突然在Set xlWB = xlApp.Workbooks.Open(FileName:=xlPath).

在我看来，这完全是随机的。我认为可能是导致这些问题的 Microsoft Word 环境中的某种限制或错误。任何人都知道这些奇怪错误的原因可能是什么？

我的代码找不到任何不寻常的地方，但也许 SO 上的某个人看到的东西立即看起来很奇怪。很抱歉代码非常混乱。

Sub Test()
    Dim comment, text As String
    Dim pageNr As Integer
    Dim codePrefix, fileName As String
    Dim newLinePos, leftParPos, rightParPos As Integer
    Dim commentNr As Integer
    Dim codeWorksheetIndex As Integer
    Dim xlFile, xlDir, xlPath As String
    
    'Excel'
    Dim xlApp As Object
    Dim xlWB As Object

    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err Then
        Set xlApp = CreateObject("Excel.Application")
    End If
    On Error GoTo 0

    xlFile = "TEST"
    xlDir = "My\Directory\path\" 'censored
    xlPath = xlDir & xlFile
    Set xlWB = xlApp.Workbooks.Open(FileName:=xlPath)

    codePrefix = "a-code" 'censored
    fileName = Left(ActiveDocument.Name, Len(ActiveDocument.Name)-5)

    'insert a column as second column in each spreadsheet'
    For sheet_index = 1 to 3
        With xlWB.Worksheets(sheet_index)
            .Range("B:B").Insert
            .Cells(1, 2).Formula = fileName
        End With
    Next sheet_index

    For commentNr = 1 To ActiveDocument.Comments.Count
        Dim category As String
        Dim categories(1 to 2) As String
        Dim categoryCount As Integer
        Dim numLeft, numRight as Integer
        'Dim j As Integer
       
        comment = LCase(ActiveDocument.Comments(commentNr).Range)
        text = ActiveDocument.Comments(commentNr).Scope
        pageNr = ActiveDocument.Comments(commentNr).Scope.Information(wdActiveEndPageNumber)

        'find newline'
        newLinePos = InStr(comment, vbCr)

        If newLinePos = 0 Then
            newLinePos = InStr(comment, vbLf)
            If newLinePos = 0 Then
                newLinePos = InStr(comment, vbCrLf)
                if newLinePos = 0 then
                    newLinePos = InStr(comment, Chr(10))
                    if newLinePos = 0 then
                        ActiveDocument.Content.InsertAfter Text:="ERROR: comment " & commentNr & " misses newline!" & vbNewLine
                    End If
                End If 
            End If
        End If 

        'set to initial index for leftpar instr'
        rightParPos = 1
        categoryCount = 0

        Do

            leftParPos = InStr(rightParPos, comment, "(")
            rightParPos = InStr(leftParPos, comment, ")")

            If leftParPos > 0 and rightParPos > 0 Then
                numLeft = rightParPos-1
                numRight = numLeft - leftParPos
                category = Trim(Right(Left(comment, numLeft), numRight))

                categories(categoryCount) = category

                categoryCount = categoryCount + 1
            End If
        Loop While leftParPos > 0 And rightParPos > 0

        comment = fileName & " (s. " & pageNr & ")" & vbNewLine & Trim(Right(comment, Len(comment)-newLinePos))

        If Instr(LCase(comment), codePrefix) = 1 Then

            For categoryIndex = 0 To categoryCount-1

                category = categories(categoryIndex)

                If category = "category1" Then
                    codeWorksheetIndex = 1
                ElseIf category = "category2" Then
                    codeWorksheetIndex = 2
                ElseIf category = "category3" Then
                    codeWorksheetIndex = 3
                End If

                With xlWB.Worksheets(codeWorksheetIndex)
                    .Cells(commentNr+1, 2).Formula = text
                    .Cells(commentNr+1, 2).NoteText comment 'this only worked without =
                End With
            Next categoryIndex

        End If

    Next commentNr

End Sub

标签： excelvbams-word

excel - 不可预测的错误 VBA microsoft word 将注释和文本复制到 excel

问题描述

解决方案

推荐阅读