Question

好的，我一直在拼凑代码来自动执行任务。我有一个word文档，有300行，每个行都有一个标识号，标题和一个网站。我想通过标识符分别搜索文档标题和网站，并分别将它们输入到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的记录

一般说明

将其插入Excel代码模块
在ParseWordDocument()
用手指交叉
运行ParseWordDocument()
让我知道它是怎么回事

  

    Option Explicit

    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)

        With Worksheets(TargetSheetName)

            lastRow = .Cells(Rows.Count, iID).End(xlUp).Row + 1

            For x = 2 To lastRow

                For y = 0 To UBound(arData, 2)
                    id = Trim(.Cells(x, iID))
                    If Len(id) And (id = arData(0, y)) Then
                        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), Address:=hAddress, ScreenTip:=hScreenTip, TextToDisplay:=hTextToDisplay
                        arData(0, y) = ""
                        Exit For
                    End If

                Next

            Next

            For y = 0 To UBound(arData, 2)

                id = arData(0, y)
                If Len(id) Then
                    title = arData(1, y)
                    hAddress = arData(2, y)
                    hScreenTip = arData(3, y)
                    hTextToDisplay = arData(4, y)

                    .Cells(lastRow, iID) = id
                    .Cells(lastRow, iTitle) = title
                    .Hyperlinks.Add .Cells(lastRow, iHyperLink), Address:=hAddress, ScreenTip:=hScreenTip, TextToDisplay:=hTextToDisplay
                    arData(0, y) = ""
                    lastRow = lastRow + 1
                End If

            Next

        End With


    End Sub

    Function getWordDocArray(WordPath As String, Optional ShowWord As Boolean = False) As Variant
        Dim i As Integer, iStart As Integer, iEnd As Integer
        Dim id As String, title As String
        Dim arData, s
        Dim wdApp, wdDoc, h

        Set wdApp = CreateObject("Word.Application")
        Set wdDoc = wdApp.Documents.Open(Filename:=WordPath, ReadOnly:=True)

        wdApp.Visible = ShowWord

        ReDim arData(4, 0)

        For Each s In wdDoc.Sentences
            On Error GoTo SkipSentence

            iStart = InStr(s.Text, s.Words(2))
            iEnd = InStr(s.Text, "(") - iStart
            id = Trim(s.Words(1))
            title = Mid(s.Text, iStart, iEnd)
            Set h = s.Hyperlinks(1)

            ReDim Preserve arData(4, i)
            arData(0, i) = id
            arData(1, i) = title
            arData(2, i) = h.Address
            arData(3, i) = h.ScreenTip
            arData(4, i) = h.TextToDisplay

            i = i + 1
    SkipSentence:
            On Error GoTo 0
        Next

        getWordDocArray = arData

        If Not ShowWord Then
            wdDoc.Close False
            wdApp.QUIT
        End If

        Set wdDoc = Nothing
        Set wdApp = Nothing
    End Function

搜索Word文档并在Excel中列出值

1 个答案: