利用ExcelVBA提取word中的数据

sw3392787

182197315 发表于 2018-4-4 20:18
Sub test()
Dim i%, k%, myPath$, myFile$, arr(1 To 100, 1 To 29)
Dim wdApp As New Word.Application
...

谢谢，上周都没时间上来，感谢你的帮助

芸谣

Moneky 发表于 2018-4-3 21:05
楼主，每当这个时候我都要给我自己的工具Doc2Xls打广告，我的Doc2Xls可以完美解决。

下载了，用不了

芸谣

啊，想实现这个功能，但是完全不懂VB啊，要疯了

LMY123

芸谣 发表于 2018-12-23 03:19
啊，想实现这个功能，但是完全不懂VB啊，要疯了

Sub W_TO_E_提取文字及表格数据_参考()
    Cells.Clear
    Cells.NumberFormatLocal = "@"
    Dim 外档数组, 结果数组(1 To 60000, 1 To 1)
    Application.ScreenUpdating = False: Application.DisplayAlerts = False
    Set wd = CreateObject("word.Application")
    路径 = ThisWorkbook.Path & "\"
    外档 = Dir(路径 & "*.doc*")
    Do While 外档 <> ""
        计数器 = 0
        文档计数器 = 文档计数器 + 1
        With wd.Documents.Open(路径 & 外档)
            .Range.ListFormat.ConvertNumbersToText
            外档数组 = Split(.Range.Text, Chr(13))
            .Close False
        End With
        Cells(1, 文档计数器) = Split(外档, ".")(0)
        For i = 0 To UBound(外档数组)
        If 外档数组(i) <> "" And Len(外档数组(i)) Then
            计数器 = 计数器 + 1
            结果数组(计数器, 文档计数器) = Replace(外档数组(i), "", "")
            End If
        Next
        外档 = Dir
    Loop
    wd.Quit
    Range("a2").Resize(计数器, 1) = 结果数组
    Application.DisplayAlerts = True: Application.ScreenUpdating = True
    MsgBox "ok"
End Sub

Moneky

芸谣 发表于 2018-12-23 03:18
下载了，用不了

针对楼主一楼的附件制作的模版 ↓↓


工具处理过程演示 ↓↓↓  完美支持

cjc209

opiona 发表于 2018-4-4 00:27

可不可以用Application.Clean(Cell.Range.Text) 代替Replace 我测试了可以 这样更简单

cjc209

就是去除非打印字符 函数的使用

opiona

可以啊，不错的建议！

renjin

谢谢分享！

394167692

非常有用的工具 谢谢啦