主题：[求助]提取word文档字符串

Dim dlg As new OpenFileDialog
dlg.Filter = "word|*.doc;*.docx"
If dlg.ShowDialog = DialogResult.OK Then
    Dim app As New MSWord.Application
    try
        Dim doc = app.Documents.Open(dlg.fileName)
        Dim count = Doc.Characters.Count
        Dim rng As MSWord.Range = Doc.Range(Start:=0, End:=count)
        msgbox(rng.Text)
        Dim str As String = rng.text
        Dim mc = System.Text.RegularExpressions.Regex.Matches(str, "(?<=裁定如下).*?(?=审  判  长)")
        If mc.count >= 1 Then
            msgbox("裁定")
            For i As Integer = 0 To mc.count-1
                msgbox(mc(i).value)
            Next
        Else
            mc = System.Text.RegularExpressions.Regex.Matches(str, "(?<=判决如下).*?(?=审  判  长)")
            If mc.count >= 0 Then
                msgbox("判决")
                For i As Integer = 0 To mc.count-1
                    msgbox(mc(i).value)
                Next
            Else
                msgbox("无法识别")
            End If
        End If
        app.Quit
    catch ex As exception
        msgbox(ex.message)
        app.Quit
    End try
End If

肯定可以，看红色代码，想办法弄到路径。

    Dim app As New MSWord.Application
    try
        Dim doc = app.Documents.Open("d:\test.doc")
        Dim count = Doc.Characters.Count
        Dim rng As MSWord.Range = Doc.Range(Start:=0, End:=count)
        msgbox(rng.Text)
        Dim str As String = rng.text
        Dim mc = System.Text.RegularExpressions.Regex.Matches(str, "(?<=裁定如下).*?(?=审  判  长)")
        If mc.count >= 1 Then
            msgbox("裁定")
            For i As Integer = 0 To mc.count-1
                msgbox(mc(i).value)
            Next
        Else
            mc = System.Text.RegularExpressions.Regex.Matches(str, "(?<=判决如下).*?(?=审  判  长)")
            If mc.count >= 0 Then
                msgbox("判决")
                For i As Integer = 0 To mc.count-1
                    msgbox(mc(i).value)
                Next
            Else
                msgbox("无法识别")
            End If
        End If
        app.Quit
    catch ex As exception
        msgbox(ex.message)
        app.Quit
    End try

修改代码

Dim dr As DataRow = e.DataRow
Dim file = e.SourceFolder & "\" & e.filename
If dr.IsNull("案号") Or dr.IsNull("承办人")  Then
    MessageBox.Show("案号及承办人不能为空!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
    e.Cancel = True
Else
    e.FileName = dr("案号") & ".doc"
End If

Select Case e.DataCol.Name
    Case "裁判文书"
        e.Subfolder = e.DataRow("承办人")  '将此文件存放在目录名为承办人名称的子目录中.
        Dim app As New MSWord.Application
        try
            Dim doc = app.Documents.Open(file)
            Dim count = Doc.Characters.Count
            Dim rng As MSWord.Range = Doc.Range(Start:=0, End:=count)
            msgbox(rng.Text)
            Dim str As String = rng.text
            Dim mc = System.Text.RegularExpressions.Regex.Matches(str, "(?<=裁定如下).*?(?=审  判  长)")
            If mc.count >= 1 Then
                msgbox("裁定")
                For i As Integer = 0 To mc.count-1
                    msgbox(mc(i).value)
                Next
            Else
                mc = System.Text.RegularExpressions.Regex.Matches(str, "(?<=判决如下).*?(?=审  判  长)")
                If mc.count >= 0 Then
                    msgbox("判决")
                    For i As Integer = 0 To mc.count-1
                        msgbox(mc(i).value)
                    Next
                Else
                    msgbox("无法识别")
                End If
            End If
            app.Quit
        catch ex As exception
            msgbox(ex.message)
            app.Quit
        End try
End Select

关键看afterOpenProject事件的代码，设置 DefaultFolder
 
然后看这句代码 e.Subfolder = e.DataRow("承办人") 

局域网路径的话，只需要修改DefaultFolder的路径即可

回复13楼，得到的字符串，再用回车符分割，然后读取即可，如

Dim str = "123" & vbcrlf & "abc" & vbcrlf & "455"
msgbox(str)
Dim ary() = str.replace(chr(10), "").split(chr(13))
msgbox(ary(0))
msgbox(ary(2))

可以，只要是符合规律的，都可以。代码参考14楼。

Dim str = "123" & vbcrlf & vbcrlf & vbcrlf & "本院认为:111abc" & vbcrlf & "45aaa5" & vbcrlf & "123"
msgbox(str)
Dim ary() = str.replace(chr(10), "").split(chr(13))
Dim ls As new List(Of String)
For Each s As String In ary
    If s.trim() > "" Then
        ls.add(s)
    End If
Next

For Each s As String In ls
    If s.StartsWith("本院认为") Then
        msgbox(s)
        Exit For
    End If
Next

For Each s As String In ls
    If s.contains("aaa") then
        msgbox(s)
        exit for
    end if
Next

msgbox(ls(3))

改成

Dim ary() = str.replace(chr(10), chr(13)).split(chr(13))