[已解决]请大神帮忙解决个很有难度的问题

nanohappy

使用EXCEL VBA获取WORD文件里的部分内容，自动生成(表头字段可以不用自动的),请各位大神们多多指教. Thank.zip (81.3 KB, 下载次数: 5)

2013-6-25 16:29 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

爱疯

2013-6-25 18:45

Sub test()
    Dim p$, f$, A(), doc, i%, n%

    n = 999
    ReDim A(1 To n, 1 To 9)    '999 是估计的最大文件数
    p = ThisWorkbook.Path & "\"
    f = Dir(p & "*.rtf")


    Do While f <> ""
        i = i + 1
        Set doc = GetObject(p & f)
        With doc.Tables(2)
            A(i, 1) = z(.cell(2, 2))
            A(i, 2) = z(.cell(3, 2))
            A(i, 3) = z(.cell(4, 2))
            A(i, 4) = z(.cell(5, 2))
            A(i, 5) = z(.cell(6, 2))
            A(i, 6) = z(.cell(7, 2))
        End With
        With doc.Tables(3)
            A(i, 7) = z(.cell(3, 2))
            A(i, 8) = z(.cell(4, 2))
            A(i, 9) = z(.cell(5, 2))
        End With
        doc.Close 0
        f = Dir
    Loop


    With Range("a2:i" & n)
        .ClearContents
        If i > 0 Then .Resize(i, UBound(A, 2)) = A
    End With

End Sub


Function z(str As String) As String
    z = Replace(str, Chr(13), "")
    z = Replace(z, Chr(7), "")
End Function



Thank2.rar (84.34 KB, 下载次数: 9)

2013-6-25 18:45 上传

点击文件名下载附件

跳转到最佳答案楼层

爱疯

Sub test()
    Dim p$, f$, A(), doc, i%, n%

    n = 999
    ReDim A(1 To n, 1 To 9)    '999 是估计的最大文件数
    p = ThisWorkbook.Path & "\"
    f = Dir(p & "*.rtf")


    Do While f <> ""
        i = i + 1
        Set doc = GetObject(p & f)
        With doc.Tables(2)
            A(i, 1) = z(.cell(2, 2))
            A(i, 2) = z(.cell(3, 2))
            A(i, 3) = z(.cell(4, 2))
            A(i, 4) = z(.cell(5, 2))
            A(i, 5) = z(.cell(6, 2))
            A(i, 6) = z(.cell(7, 2))
        End With
        With doc.Tables(3)
            A(i, 7) = z(.cell(3, 2))
            A(i, 8) = z(.cell(4, 2))
            A(i, 9) = z(.cell(5, 2))
        End With
        doc.Close 0
        f = Dir
    Loop


    With Range("a2:i" & n)
        .ClearContents
        If i > 0 Then .Resize(i, UBound(A, 2)) = A
    End With

End Sub


Function z(str As String) As String
    z = Replace(str, Chr(13), "")
    z = Replace(z, Chr(7), "")
End Function



Thank2.rar (84.34 KB, 下载次数: 9)

2013-6-25 18:45 上传

点击文件名下载附件

nanohappy

爱疯 发表于 2013-6-25 18:45
Sub test()
    Dim p$, f$, A(), doc, i%, n%

非常感谢这位朋友！     感谢
   谢版主！

nanohappy

爱疯 发表于 2013-6-25 18:45
Sub test()
    Dim p$, f$, A(), doc, i%, n%

版主请教个问题，，， 请问你打开rtf后 是如何找到表格的？我真没看懂啊。。。