For Each file In FileSys.GetFiles(path)
Dim excelcol As Integer
Dim excelrows As Integer
If file.EndsWith(".xls") OrElse file.EndsWith(".xlsx") Then
DataTables("表A").StopRedraw
Dim App As New MSExcel.Application
app.DisplayAlerts=False '是否显示EXCEL警示
try
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(file)
For k As Integer = 1 To wb.workSheets.Count '//多个sheet的处理
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(k)
Dim Rg As MSExcel.Range = Ws.UsedRange
Dim RowsMax As Integer =0
Dim ColsMax As Integer = 0
'获取有效行
For i As Integer =1 To rg.Columns.count
Dim r = ws.cells(excelrows,i).End(MsExcel.XlDirection.xlUp).Row
If r > RowsMax Then
RowsMax = r
End If
Next
'获取有效列
For i As Integer = 1 To rowsMax
Dim r = ws.cells(i,excelcol).End(MsExcel.XLDirection.xlToLeft).Column
If r > ColsMax Then
ColsMax = r
End If
Next
rg = Ws.Range(Ws.Cells(1,1), Ws.Cells(RowsMax,ColsMax))
Dim ary = rg.value
For i As Integer = 1 To RowsMax
If CBox2.Checked OrElse rg.Rows(i).height <> 0 Then
For j As Integer = 1 To Colsmax
If CBox2.Checked OrElse rg.Columns(j).width <> 0 Then
If ary(i,j) <> Nothing Then
If CBox1.Checked = False OrElse CBox1.Checked = True AndAlso System.Text.RegularExpressions.Regex.Match(ary(i,j),"[\u4e00-\u9fa5]+").Tostring()>""
Dim dr As DataRow = DataTables("表A").AddNew
dr("原文") = ary(i, j)
lbl5.text ="提取内容:" & ary(i,j)
Application.DoEvents
End If
End If
End If
Next
End If
Next
Next
Wb.Close()
Dim txt1 As WinForm.TextBox = Forms("提取工具").Controls("TextBox3")
txt1.text = file & vbcrlf & txt1.text & vbcrlf
Application.DoEvents()
FileCount=FileCount+1
lbl.Text="已提取" & FileCount & "个文件,未提取 " & BadFileCount & "个文件"
Catch ex As Exception
Dim txt2 As WinForm.TextBox = Forms("提取工具").Controls("TextBox4")
txt2.text = file & vbcrlf & txt2.text & vbcrlf
BadFileCount =BadFileCount +1
msgbox(ex.message)
End try
DataTables("表A").ResumeRedraw
app.quit()
GC.ColLECT
End If
Next
For Each p As String In FileSys.GetDirectories(path)
Functions.Execute("MSEXCEL提取", p)
Next
加好友 
发短信
Post By：2017/2/6 17:54:00 [显示全部帖子]
