searchWord文档并在Excel中列出值

好吧，我一直在编码代码自动执行任务。 我有一个像300行的文档，每个文档都有一个标识号，一个标题和一个网站。 我想通过标识符来search文档，分别将标题和网站分别放入excel表格中。 标识符已经在excel中列出，我希望他们能够匹配相应的信息。

我知道它真的很杂乱 –

Public Sub ParseDoc() Dim list As Workbook Dim doc As Document Set doc = "C:\network\path\importantlist.doc" Dim paras As Paragraphs Set paras = doc.Paragraphs Dim para As Paragraph Dim sents As Sentences Dim sent As Range Set list = ActiveSheet Dim i As Integer Dim mystring As String Dim length As Integer Dim space As String Dim dot As String Dim space1 As String Dim space2 As String Dim XYZ As Range dot = "." space = " " i = 1 While i < 300 'This loops for the duration of the identifier list in excel mystring = Cells(i, 1) ' this pulls the unique identifier from the cell For Each para In paras Set sents = para.Range.Sentences ' this searches the document by paragraphs to sentences For Each sent In sents If InStr(1, sent, mystring) <> 0 Then 'If a the identifier is found space1 = InStr(1, sent, space, vbTextCompare) 'measure the length to the first blank space (this indicates the title is about to begin) space2 = InStr(1, sent, dot, vbTextCompare) ' This dot is the ".doc" and indicates the title has concluded, I want the text between these two characters Set XYZ = Start:= space1.range.start End:= space2.range.start 'Here is where I am stuck, I have never used range or selection before and after looking around, I still feel very much at a loss on how to proceed forward... Next Next End Sub 

Answer 1

更新：

• 更新匹配ID的值
• 附加没有匹配ID的logging

一般说明

• 将其插入到Excel代码模块中
• 在ParseWordDocument()为常量设置正确的值
• 交叉你的手指
• 运行ParseWordDocument()
• 让我知道它是如何去的

  

    选项显式

     Sub ParseWordDocument（）
         const WordPath As String =“C：\ Users \ best buy \ Downloads \ stackoverflow \ Sample Files \ A203 Paralegal.docx”
         Const iID = 1
         Const iTitle = 2
         Const iHyperLink = 3
         Const TargetSheetName As String =“Sheet1”
         Dim k As String，id As String，title As String，hAddress As String，hScreenTip As String，hTextToDisplay As String
         Dim lastRow As Long，x As Long，y As Long
         Dim arData，h

         arData = getWordDocArray（WordPath，False）

        使用工作表（TargetSheetName）

             lastRow = .Cells（Rows.Count，iID）.End（xlUp）.Row + 1

            对于x = 2到lastRow

                对于y = 0到UBound（arData，2）
                     id = Trim（.Cells（x，iID））
                    如果Len（id）和（id = arData（0，y））那么
                         id = Trim（.Cells（x，iID））
                         title = arData（1，y）
                         hAddress = arData（2，y）
                         hScreenTip = arData（3，y）
                         hTextToDisplay = arData（4，y）

                         .Cells（x，iTitle）= title
                         .Hyperlinks.Add .Cells（x，iHyperLink），地址：= hAddress，ScreenTip：= hScreenTip，TextToDisplay：= hTextToDisplay
                         arData（0，y）=“”
                        退出
                    万一

                下一个

            下一个

            对于y = 0到UBound（arData，2）

                 id = arData（0，y）
                如果Len（id）那么
                     title = arData（1，y）
                     hAddress = arData（2，y）
                     hScreenTip = arData（3，y）
                     hTextToDisplay = arData（4，y）

                     .Cells（lastRow，iID）= id
                     .Cells（lastRow，iTitle）=标题
                     .Hyperlinks.Add。细胞（lastRow，iHyperLink），地址：= hAddress，ScreenTip：= hScreenTip，TextToDisplay：= hTextToDisplay
                     arData（0，y）=“”
                     lastRow = lastRow + 1
                万一

            下一个

        结束


    结束小组

     Function getWordDocArray（WordPath As String，可选的ShowWord为Boolean = False）作为Variant
        昏暗我整数，iStart整数，iEnd整数
         Dim id As String，title As String
         Dim arData，s
        昏暗的wdApp，wdDoc，h

        设置wdApp = CreateObject（“Word.Application”）
        设置wdDoc = wdApp.Documents.Open（文件名：= WordPath，ReadOnly：= True）

         wdApp.Visible = ShowWord

         ReDim arData（4，0）

        对于wdDoc.Sentences中的每个人
            在错误转到SkipSentence

             iStart = InStr（s.Text，s.Words（2））
             iEnd = InStr（s.Text，“（”） -  iStart
             id = Trim（s.Words（1））
             title = Mid（s.Text，iStart，iEnd）
            设置h = s.Hyperlinks（1）

             ReDim保存arData（4，i）
             arData（0，i）= id
             arData（1，i）=标题
             arData（2，i）= h.Address
             arData（3，i）= h.ScreenTip
             arData（4，i）= h.TextToDisplay

            我=我+ 1
     SkipSentence：
            在错误转到0
        下一个

         getWordDocArray = arData

        如果不显示，那么
             wdDoc.Close False
             wdApp.QUIT
        万一

        设置wdDoc = Nothing
        设置wdApp = Nothing
    结束function