Private Sub Command2_Click()
Dim i As Integer
Dim j As Integer
j = 0
For i = 1 To File1.ListCount
j = j + 1
Dim myword_1 As New Word.Application
Dim doc1 As New Word.Document
Dim lujing As String
Set myword_1 = CreateObject("word.application")
myword_1.Visible = False
lujing = File1.Path + "\" + File1.List(j - 1)
Set doc1 = myword_1.Documents.Open(lujing) '注：如果其中有以docx结尾的就会出错。
Dim st_1 As String
Dim st_2 As String
Dim st_3 As String
Dim Sid As String
Dim Sname As String
Dim SnameWithDot As String
Dim length As Integer
Dim dot As Integer
Dim title As String
Dim txtSQL As String
Dim mrc As ADODB.Recordset
Dim MsgText As String
'提取实验报告中的第一个表格中的内容
st_1 = doc1.Tables(1).Cell(4, 1).Range.Text
st_2 = doc1.Tables(1).Cell(5, 1).Range.Text
st_3 = doc1.Tables(1).Cell(6, 1).Range.Text
'连接数据库
Sid = Mid(File1.List(j - 1), 1, 15)
title = Mid(File1.List(j - 1), 16, 3)
SnameWithDot = Mid(File1.List(j - 1), 19)
length = Len(SnameWithDot)
dot = InStr(SnameWithDot, ".")
Sname = Mid(SnameWithDot, 1, dot - 1)
txtSQL = ""
txtSQL = "select * from Labor where id='" & Trim(Sid) & "' "
Set mrc = ExecuteSQL(txtSQL, MsgText)
If mrc.EOF = True Then
mrc.AddNew
mrc.Fields(0).Value = Sid
mrc.Fields(1).Value = title
mrc.Fields(2).Value = Left(st_1, Len(st_1) - 1) ' Left(st_1, Len(st_1) - 1)联系上文的st_1 = doc1.Tables(1).Cell(4, 1).Range.Text就是提取的实验内容里的内容
mrc.Fields(3).Value = Left(st_2, Len(st_2) - 1)
mrc.Fields(4).Value = Left(st_3, Len(st_3) - 1)
mrc.Fields(5).Value = Sname
mrc.Update
mrc.Close
Text1.Text = Text1.Text + File1.List(j - 1) + "记录添加成功！" + vbCrLf
Else
Text1.Text = Text1.Text + File1.List(j - 1) + "记录之前已添加！" + vbCrLf
End If
doc1.Close
myword_1.Quit
Next i
MsgBox "记录添加完成！"
End Sub
