20171022xlVBA练手提取入所记录
Sub GetWordText改进()
Dim Wb As Workbook
Dim Sht As Worksheet
Dim Rng As Range Dim wdApp As Object
Dim wdDoc As Object
Dim FilePaths
Dim FilePath
Dim Arr(1 To 10000, 1 To 6)
Dim n As Long
Dim Index As Long Dim Regex As Object
Dim Mh As Object
Pattern = ".*?[::](\S*)\s*?.*?[::](\S*)\s*?" & _
".*?[::](\S*)\s*?.*?[::](\S*)\s*?" & _
".*?[::](\S*)\s*?.*?[::](\S*)"
Set Regex = CreateObject("VBScript.RegExp")
With Regex
.Global = True
.Pattern = Pattern
End With Set Wb = Application.ThisWorkbook
Set Sht = Wb.Worksheets("汇总")
With Sht
.UsedRange.Offset(1).ClearContents
End With
FilePaths = FsoGetFiles(Wb.Path & "\", "*.doc*")
If FilePaths(1) = "None" Then Exit Sub
Index = 0 Set wdApp = CreateObject("Word.Application")
For n = LBound(FilePaths) To UBound(FilePaths) 'On Error Resume Next
Set wdDoc = wdApp.documents.Open(FilePaths(n))
If wdDoc Is Nothing Then
GoTo NextDocument
Else
If wdDoc.Tables.Count > 0 Then
Debug.Print "含表格:"; FilePaths(n)
Index = Index + 1
For j = 1 To 6
Text = wdDoc.Tables(1).cell(1, j).Range.Text
Text = Replace(Text, Chr(10), "")
Text = Replace(Text, Chr(7), "")
Text = Replace(Text, Chr(13), "")
Arr(Index, j) = "'" & Text
Debug.Print Index; " "; Arr(Index, j)
Next j
Else
Debug.Print "纯文本:"; FilePaths(n)
If Regex.test(wdDoc.Content.Text) Then
Set Mh = Regex.Execute(wdDoc.Content.Text)
Index = Index + 1
For j = 0 To Mh.Item(0).submatches.Count - 1
Arr(Index, j + 1) = "'" & Mh.Item(0).submatches(j)
Debug.Print Index; " "; Arr(Index, j + 1)
Next j
End If
End If
End If
wdDoc.Close False
NextDocument:
On Error GoTo 0
Next n wdApp.Quit With Sht
Set Rng = .Range("A2")
Set Rng = Rng.Resize(UBound(Arr), UBound(Arr, 2))
Rng.Value = Arr
End With Set Wb = Nothing
Set Sht = Nothing
Set Rng = Nothing
Set wdApp = Nothing
Set wdDoc = Nothing End Sub
Function FsoGetFiles(ByVal FolderPath As String, ByVal Pattern As String, Optional ComplementPattern As String = "") As String()
Dim Arr() As String
Dim FSO As Object
Dim ThisFolder As Object
Dim OneFile As Object
ReDim Arr(1 To 1)
Arr(1) = "None"
Dim Index As Long
Index = 0
Set FSO = CreateObject("Scripting.FileSystemObject")
On Error GoTo ErrorExit
Set ThisFolder = FSO.getfolder(FolderPath)
If Err.Number <> 0 Then Exit Function
For Each OneFile In ThisFolder.Files
If OneFile.Name Like Pattern Then
If Len(ComplementPattern) > 0 Then
If Not OneFile.Name Like ComplementPattern Then
Index = Index + 1
ReDim Preserve Arr(1 To Index)
Arr(Index) = OneFile.Path '& OneFile.Name
End If
Else
Index = Index + 1
ReDim Preserve Arr(1 To Index)
Arr(Index) = OneFile.Path '& OneFile.Name
End If
End If
Next OneFile
ErrorExit:
FsoGetFiles = Arr
Erase Arr
Set FSO = Nothing
Set ThisFolder = Nothing
Set OneFile = Nothing
End Function
20171022xlVBA练手提取入所记录的更多相关文章
- 【Python】【辅助程序】练手小程序:记录外网动态IP地址
练手小程序 程序作用:对IP实时记录: 1.定时获取外网IP,存储在本地文件中: 编写思路: 1)收集获取外网的API接口 http://bbs.125.la/thread-1383897 ...
- 练手项目之image caption问题记录
小白一个,刚刚费了老大的劲完成一个练手项目--image caption,虽然跑通了,但是评估结果却惨不忍睹.于是贴上大神的作品,留待日后慢慢消化.顺便记录下自己踩坑的一些问题. 先膜拜下大神的作品. ...
- 去哪找Java练手项目?
经常有读者在微信上问我: 在学编程的过程中,看了不少书.视频课程,但是看完.听完之后感觉还是不会编程,想找一些项目来练手,但是不知道去哪儿找? 类似的问题,有不少读者问,估计是大部分人的困惑. 练手项 ...
- 简单的node爬虫练手,循环中的异步转同步
简单的node爬虫练手,循环中的异步转同步 转载:https://blog.csdn.net/qq_24504525/article/details/77856989 看到网上一些基于node做的爬虫 ...
- Python练手项目:20行爬取全王者全英雄皮肤
引言 王者荣耀大家都玩过吧,没玩过的也应该听说过,作为时下最火的手机MOBA游戏,咳咳,好像跑题了.我们今天的重点是爬取王者荣耀所有英雄的所有皮肤,而且仅仅使用20行Python代码即可完成. ...
- webpack练手项目之easySlide(三):commonChunks(转)
Hello,大家好. 在之前两篇文章中: webpack练手项目之easySlide(一):初探webpack webpack练手项目之easySlide(二):代码分割 与大家分享了webpack的 ...
- Python之路【第二十四篇】:Python学习路径及练手项目合集
Python学习路径及练手项目合集 Wayne Shi· 2 个月前 参照:https://zhuanlan.zhihu.com/p/23561159 更多文章欢迎关注专栏:学习编程. 本系列Py ...
- 初始Spring MVC——练手小项目
初始Spring MVC 前几天开始了我的spring学习之旅,由于之前使用过MVC模式来做项目,所以我先下手的是 Spring MVC,做个练手项目,非常简单 项目介绍: 用户输入信息 -> ...
- 70个Python练手项目列表(都有完整教程)
前言: 不管学习那门语言都希望能做出实际的东西来,这个实际的东西当然就是项目啦,不用多说大家都知道学编程语言一定要做项目才行. 这里整理了70个Python实战项目列表,都有完整且详细的教程,你可以从 ...
随机推荐
- Python3 tkinter基础 grid(row,column) 窗体的布局
Python : 3.7.0 OS : Ubuntu 18.04.1 LTS IDE : PyCharm 2018.2.4 Conda ...
- Python3基础 iter+next 进行迭代时超出了范围 产生StopIteration异常
Python : 3.7.0 OS : Ubuntu 18.04.1 LTS IDE : PyCharm 2018.2.4 Conda ...
- DNS 基础
DNS Domain Name System:域名系统,主要用来将域名解析为IP.DNS以及相关系统存在,主要有两个原因: 可以让人容易记住名字,而不是记住IP: 它允许服务器改变IP,但是采用同样的 ...
- hdfoo站点开发笔记
为了安全,也要兼顾编辑器切换管理 开发时不必管目录名称的事, 只是在部署的时候,才修改应用目录和tp目录的名字就行了. 为了提高tp的加载效率, 始终给app和tp以绝对路径.就是以 realpath ...
- mysql的 深度使用 - 游标 , 定时器, 触发器 的使用 ?
游标 叶叫做 光标; 只能使用在 mysql的 存储过程 或函数中! 游标的概念? 为什么要使用 游标? 什么叫 定时器, 就是事件 event! 是在 mysql 5.0以上的版本中, 才能使用支持 ...
- 【做题】arc068_f-Solitaire——糊结论
把所有数字放入双端队列后,结果大概是这样一个排列: \[P_1 1 P_2\] 其中\(P_1\)是递减序列,\(P_2\)是递增序列. 我们以\(1\)所在的位置\(k\)分割最终的排列\(A\). ...
- Configuring Logstash
Configuring Logstash To configure Logstash, you create a config file that specifies which plugins yo ...
- 【#和$】MyBatis中#和$的区别
一.结论 #{}:占位符号,好处防止sql注入 ${}:sql拼接符号 二.具体分析 动态 SQL 是 mybatis 的强大特性之一,也是它优于其他 ORM 框架的一个重要原因.mybatis 在对 ...
- arm中断体系结构
ARM处理器中有7种类型的异常,按优先级从高到低的排列如下: 复位异常(Reset). 数据异常(Data Abort). 快速中断异常(FIQ) ...
- 【matlab】笔记_1
基本操作 ans 最近计算的答案 clc 清除命令行窗口 diary 将命令行窗口文本保存到文件中 矩阵 用逗号 (,) 或空格分隔各行元素. 用分号(;)分隔各列元素. a':装置矩阵. 要执行元素 ...