Question

我正在尝试使用this code将注释和相应的文本从Word导出到Excel。我将代码复制并粘贴到VBA中：

Option Explicit




Public Sub FindWordComments()
'Requires reference to Microsoft Word v14.0 Object Library


Dim myWord              As Word.Application
Dim myDoc               As Word.Document
Dim thisComment         As Word.Comment

Dim fDialog             As Office.FileDialog
Dim varFile             As Variant

Dim destSheet           As Worksheet
Dim rowToUse            As Integer
Dim colToUse            As Long

Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
Set destSheet = ThisWorkbook.Sheets("Sheet1")
colToUse = 1

With fDialog
    .AllowMultiSelect = True
    .Title = "Import Files"
    .Filters.Clear
    .Filters.Add "Word Documents", "*.docx"
    .Filters.Add "Word Macro Documents", "*.docm"
    .Filters.Add "All Files", "*.*"
End With

If fDialog.Show Then

    For Each varFile In fDialog.SelectedItems

        rowToUse = 2

        Set myWord = New Word.Application
        Set myDoc = myWord.Documents.Open(varFile)

        For Each thisComment In myDoc.Comments

            With thisComment
                destSheet.Cells(rowToUse, colToUse).Value = .Range.Text
                destSheet.Cells(rowToUse, colToUse + 1).Value = .Scope.Text
                destSheet.Columns(2).AutoFit
            End With

            rowToUse = rowToUse + 1

        Next thisComment

        destSheet.Cells(1, colToUse).Value = Left(myDoc.Name, 4)
        'Put name of interview object in cell A1

        destSheet.Cells(1, colToUse + 1).Value = ActiveDocument.Words.Count
        'Put the number of words in cell B1

        Set myDoc = Nothing
        myWord.Quit

        colToUse = colToUse + 2

    Next varFile

End If

End Sub


Public Sub PrintFirstColumnOnActiveSheetToSheetName()


ActiveSheet.Name = ActiveSheet.Range("A1")


End Sub

并且VBA返回我帖子标题中的错误，并突出显示代码：

Set destSheet = ThisWorkbook.Sheets("Sheet1")

不知道从哪里开始，我可以补充说我是一个非常新手的编码器/ VBA用户。我刚刚学会了如何创建一个宏。

Answer 1

因为您在Word中运行代码，所以首先需要初始化Excel实例，然后引用选择的工作簿

所以在sub的头部插入以下代码并替换＆＃34; WorkbookName＆＃34;使用工作簿的名称。然后使用ThisWorkbook

替换代码中的wb

Dim objExcelApp As Object
Dim wb As Object
Set objExcelApp = CreateObject("Excel.Application")
Set wb = objExcelApp.Workbooks("WorkbookName")

如果工作簿已关闭，请使用

替换最后一行

Set wb = objExcelApp.Workbooks.Open("C:/Folder1/Book1.xlsm")

方法＆＃39; ThisWorkbook＆＃39;对象＆＃39; _Global＆＃39;失败 - 将评论从Word导出到Excel

1 个答案: