这是一段提取word表格中部分内容的vb代码。
vbscript
Sub 提取word表格()
mypath = ThisWorkbook.Path & "\"
myname = Dir(mypath & "*.doc*")
n = 4 ' index of rows
Range("A1:F1") = Array("课程代码", "课程名称", "专业", "备用1", "备用2", "备用3")
While myname <> ""
Set mydoc = GetObject(mypath & myname)
m = 4 ' index of rows of a table in word
With mydoc
With .Tables(1)
maxRows = .Rows.Count
'Debug.Print .Cell(2, 10).Range.text
While maxRows - m >= 2
Cells(n, 1) = .Cell(m, 3).Range.text
Cells(n, 1) = Left(Cells(n, 1), Len(Cells(n, 1)) - 1) '去除末尾小黑点,小黑点貌似代表换行符
Cells(n, 2) = .Cell(m, 4).Range.text
Cells(n, 2) = Left(Cells(n, 2), Len(Cells(n, 2)) - 1)
Cells(n, 3) = myname
m = m + 1
n = n + 1
'Cells(3, 1) = .Cell(3, 16).Range.text
'Cells(4, 1) = maxRows
Wend
End With
.Close False
End With
myname = Dir '再次调用,获取下一个文件名
Wend
MsgBox "COMPLETE"
End Sub
上述代码,可以把下面表格中课程代码和课程名称,提取到excel中。