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实战项目列表,都有完整且详细的教程,你可以从 ...
随机推荐
- vsCode设置中文
1.安装软件之后,关闭欢迎界面,Ctrl+shift+p打开命令窗口,输入lang,选择configuration display language,改为 "locale":&qu ...
- Python3基础 list insert 在指定位置挤入一个元素
Python : 3.7.0 OS : Ubuntu 18.04.1 LTS IDE : PyCharm 2018.2.4 Conda ...
- Intellij IDEA 安装配置Gradle
1.安装 到官网链接下载最新的bin版本,解压到 D:\Program Files (x86)\JetBrains\IDEA Configuration And Cache\gradle 配置环境变量 ...
- C# DataTable.Compute()用法
DataTable.Compute()用法 2010-04-07 11:28 一.DataTable.Compute()方法說明如下 作用: 计算用来传递筛选条件的当前行上的给定表达 ...
- URL重定向及跳转漏洞
URL跳转漏洞 URL 跳转漏洞是指后台服务器在告知浏览器跳转时,未对客户端传入的重定向地址进行合法性校验,导致用户浏览器跳转到钓鱼页面的一种漏洞. 使用场景 现在 Web 登录很多都接入了QQ ...
- transient关键字详解
作用 1,一旦变量被transient修饰,变量将不再是对象持久化的一部分,该变量内容在序列化后无法获得访问. 2,transient关键字只能修饰变量,而不能修饰方法和类.注意,本地变量是不能被tr ...
- Qt中中文字符 一劳永逸的解决方法
QT中中文字符问题,有没有一劳永逸的解决方法? 目前遇到有以下问题 1.字符串中有中文时,编译提示"常量中含有换行符" 2.在控制台窗口输出中文时无法正常显示,中文全部显示为? 目 ...
- C+++string类如何判断字符串为空
string类是C++STL类之一,有很丰富的接口,判断string为空是经常用到的操作. string类为空,实际也就是元素为0个. 可以按照如下方式判断: 1.string类有自己的成员函数emp ...
- 1. dubbo概述
dubbo简介: 官网:http://dubbo.io 最大程度进行解耦,降低系统耦合性,可以跨工程,跨项目; 生产者/消费者模式; jdk:1.6以上 maven:3.0以上 国际maven仓库:h ...
- hbase非结构化数据库与结构化数据库比较
目的:了解hbase与支持海量数据查询的特性以及实现方式 传统关系型数据库特点及局限 传统数据库事务性特别强,要求数据完整性及安全性,造成系统可用性以及伸缩性大打折扣.对于高并发的访问量,数据库性能不 ...