从多个WORD文档表格中提取数据到EXECL

2009年1月6日星期二

一.打开EXCEL并设置宏安全性为中。

二.利用VisualBasic控件工具箱在EXCEL表格中添加一个按钮控件。

三.编辑CommandButton1_Click()事件代码如下。(其中\*.doc代表需要导入的WORD文档在当前目录下,wDoc.Tables(3)代表Word文档中的第3个表格,X代表Word中行列的坐标,Range后面的英文字母代表导入到当前表格中的那一列)

Private Sub CommandButton1_Click()
On Error Resume Next
Dim h As Integer
Dim wApp As New Word.Application
Dim wDoc As Word.Document
Dim wTable As Word.Table wf = Dir(ThisWorkbook.Path & "\*.doc")
Do While wf > " "
Set wDoc = wApp.Documents.Open(ThisWorkbook.Path & "\" & wf)
Set wTable = wDoc.Tables(3)
h = [b65536].End(xlUp).Row + 1
With wTable
x = .Cell(1, 2).Range.Text
Range("a" & h) = Left(x, Len(x) - 2)
x = .Cell(2, 2).Range.Text
Range("b" & h) = Left(x, Len(x) - 2)
x = .Cell(3, 2).Range.Text
Range("c" & h) = Left(x, Len(x) - 2)
x = .Cell(4, 2).Range.Text
Range("d" & h) = Left(x, Len(x) - 2)
x = .Cell(5, 2).Range.Text
Range("e" & h) = Left(x, Len(x) - 2)
x = .Cell(6, 2).Range.Text
Range("f" & h) = Left(x, Len(x) - 2)
x = .Cell(7, 2).Range.Text
Range("g" & h) = Left(x, Len(x) - 2)
x = .Cell(8, 2).Range.Text
Range("h" & h) = Left(x, Len(x) - 2)
x = .Cell(9, 2).Range.Text
Range("i" & h) = Left(x, Len(x) - 2)
x = .Cell(10, 2).Range.Text
Range("j" & h) = Left(x, Len(x) - 2)
x = .Cell(11, 2).Range.Text
Range("k" & h) = Left(x, Len(x) - 2)
x = .Cell(12, 2).Range.Text
Range("l" & h) = Left(x, Len(x) - 2)
x = .Cell(13, 2).Range.Text
Range("m" & h) = Left(x, Len(x) - 2)
x = .Cell(14, 2).Range.Text
Range("n" & h) = Left(x, Len(x) - 2)
x = .Cell(15, 2).Range.Text
Range("o" & h) = Left(x, Len(x) - 2)
x = .Cell(16, 2).Range.Text
Range("p" & h) = Left(x, Len(x) - 2)
x = .Cell(17, 2).Range.Text
Range("q" & h) = Left(x, Len(x) - 2)
x = .Cell(18, 2).Range.Text
Range("r" & h) = Left(x, Len(x) - 2)
x = .Cell(19, 2).Range.Text
x = Left(x, Len(x) - 2)
Range("s" & h) = Trim(Mid(x, InStr(x, "组树数量:") + 5))
End With
Set wTable = Nothing
wDoc.Close
Set wDoc = Nothing
wf = Dir
Loop
Set wApp = Nothing
End Sub