|
发表于 2015-10-22 20:34
来自手机
|
显示全部楼层
我也遇到过同样的问题,代码如下:Sub 汇总() Wordapp As Word.Application Dim WordD As Word.Document Dim cPath$, cFile$, m%, Arr(1 To 1000, 1 To 6) cPath = ThisWorkbook.Path & "\" Set Wordapp = New Word.Application cFile = Dir(cPath & "*.doc") Do While cFile <> "" Set WordD = Wordapp.Documents.Open(cPath & cFile) m = m + 1 With WordD.Tables(1) Arr(m, 1) = Replace(.Cell(2, 2).Range.Text, Chr(7), "") Arr(m, 2) = Replace(.Cell(1, 2).Range.Text, Chr(7), "") Arr(m, 3) = Replace(.Cell(3, 2).Range.Text, Chr(7), "") Arr(m, 4) = Replace(.Cell(6, 2).Range.Text, Chr(7), "") Arr(m, 5) = DateValue(Replace(.Cell(4, 4).Range.Text, Chr(7), "")) Arr(m, 6) = DateValue(Replace(.Cell(5, 4).Range.Text, Chr(7), "")) End With WordD.Close cFile = Dir Loop Set WordD = Nothing Wordapp.Quit Me.Range("a65536").End(xlUp)(2).Resize(m, 6).Value = Arr End Sub |
|