Sub MainProc()
Dim Sht As Worksheet
Dim Wb As Workbook
Set Wb = Application.ThisWorkbook
Set Sht = Wb.Worksheets(1)
Sht.Cells.Clear
Sht.Range("A1:D1").Value = Array("中文标题", "英文标题", "关键词", "文件名称")
'FolderPath = Wb.Path & "\指定文件夹\"
FolderPath = FolderPicker
If FolderPath = "" Then Exit Sub
Filename = Dir(FolderPath & "*.doc*")
Dim wdApp As Object
Dim doc As Object
Dim tb As Object
Dim p As Object
Dim keys As String
Dim IsGet As Boolean
Dim chnTitle As String
Dim enTitle As String
Set wdApp = CreateObject("Word.Application")
counter = 1
Do While Filename <> ""
FilePath = FolderPath & Filename
Set doc = wdApp.documents.Open(FilePath)
IsGet = False
keys = ""
chnTitle = ""
enTitle = ""
counter = counter + 1
With doc
Set tb = .Tables(1)
chnTitle = tb.Cell(1, 2).Range.Text
enTitle = tb.Cell(2, 2).Range.Text
For Each p In doc.Paragraphs
i = i + 1
' Debug.Print i; " "; p.Range.Text
If p.Range.Text Like "*中文关键词*" Then IsGet = True
If p.Range.Text Like "*查新项目的查新点*" Then IsGet = False
If IsGet And Not p.Range.Text Like "*关键词*" Then
keys = keys & p.Range.Text
End If
Next
End With Sht.Cells(counter, 1).Value = chnTitle
Sht.Cells(counter, 2).Value = enTitle
Sht.Cells(counter, 3).Value = keys
Sht.Cells(counter, 4).Value = Filename
doc.Close False
Filename = Dir
Loop
wdApp.Quit
Set wdApp = Nothing
Set doc = Nothing
Set Wb = Nothing
Set Sht = Nothing
End Sub
Function FolderPicker() As String
Dim FolderPath As String
InitialPath = Application.ActiveWorkbook.Path
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.InitialFileName = InitialPath
If .Show = -1 Then
FolderPath = .SelectedItems(1)
Else
MsgBox "您没有选中任何文件夹,本次汇总中断!"
End If
End With
If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\"
FolderPicker = FolderPath
End Function

  

20190226_xlVba提取查新标题和关键词的更多相关文章

  1. dedecms头部标签(标题,关键词,描述标签)(借用)

    先说说dedecms头部标题,关键词,描述标签的作用我相信网络上也有很多这样的信息,那为什么我还要写这个?因为这个对我们初学者来说还是比较重要的,因为做SEO就要用到这些标签.首先我写下首页头部标签我 ...

  2. excel批量提取网页标题

    最近时间比较忙,有时候很多网页需要临时保存,以便空闲的时候查看.单纯的保存网页链接会让人很枯燥,所以需要自动批量提取标题. 为了这个小功能去写个小程序有点不划算,所以就利用excel实现了这个功能. ...

  3. WordPress简洁的SEO标题、关键词和描述

    WordPress标题.关键词和描述,之所以简洁,那是站在SEO的角度来考虑的. 首先,现在关键词这个标签早已被搜索引擎扔进历史的垃圾堆,所以这个keywords标签已经没用了,不写也罢. 其次,描述 ...

  4. python提取百度经验<标题,发布时间,平均流量,总流量,具体的链接>

    之前想研究下怎么抓网页数据.然后就有了下面的练习了. 如有BUG.也纯属正常. 只是练习.请勿投入产品使用. #!/usr/bin/python # -*- coding: utf-8 -*- #Fi ...

  5. java 使用正则表达式从网页上提取网站标题

    如何从网页上抓取有价值的东西?看懂了下面的程序(非常简单),想从网页上抓取什么信息(标题.内容.Email.价格等)就能抓取什么信息. package catchhtml; import java.i ...

  6. Gradle +HanLP +SpringBoot 构建关键词提取,摘要提取 。入门篇

    前段时间,领导要求出一个关键字提取的微服务,要求轻量级. 对于没写过微服务的一个小白来讲.有点赶鸭子上架,但是没办法,硬着头皮上也不能说不会啊. 首先了解下公司目前的架构体系,发现并不是分布式开发,只 ...

  7. hanlp提取文本关键词的使用方法记录

    本文是csu_zipple 分享的关于使用hanlp汉语言处理包提取关键词的过程一个简单的记录分享.想要使用hanlp提取文本关键词的新手朋友们可以参考学习一下! 如何在一段文本之中提取出相应的关键词 ...

  8. 基于TextRank提取关键词、关键短语、摘要

    一.TextRank原理 TextRank是一种用来做关键词提取的算法,也可以用于提取短语和自动摘要.因为TextRank是基于PageRank的,所以首先简要介绍下PageRank算法. 1. Pa ...

  9. 关键词提取算法-TextRank

    今天要介绍的TextRank是一种用来做关键词提取的算法,也可以用于提取短语和自动摘要.因为TextRank是基于PageRank的,所以首先简要介绍下PageRank算法. 1.PageRank算法 ...

随机推荐

  1. Ps去除背景

    http://www.16xx8.com/photoshop/jiaocheng/26905.html

  2. 作业2:git使用

    作业要求来自于:https://edu.cnblogs.com/campus/gzcc/GZCC-16SE2/homework/2097 远端库地址:https://github.com/yellow ...

  3. 设计模式之——bridge模式

    Bridge模式,又叫桥接模式,是针对同一接口进行扩展与实现操作的一种设计模式. 这种模式,与之前学过的适配器模式具有相似的地方,也有不同的地方,下面就让我们一一解析吧. 首先,我们要了解到,为什么需 ...

  4. python摸爬滚打之day26----网络编程之socket

    1.网络通信原理 互联网的本质就是一系列的网络协议, 统称为互联网协议. 互联网协议的功能:定义计算机如何接入internet,以及接入internet的计算机通信的标准. 互联网协议按照功能不同分为 ...

  5. 浅尝 Vue 中的 computed 属性 与 watch

    对于 computed 的理解: ①.computed 用来监控自己定义的变量,该变量不在 data 里面声明,直接在 computed里面定义,然后就可以在页面上进行双向数据绑定展示出结果或者用作其 ...

  6. Objective-C语法之代码块(block)的使用 (转载)

    代码块本质上是和其他变量类似.不同的是,代码块存储的数据是一个函数体.使用代码块是,你可以像调用其他标准函数一样,传入参数数,并得到返回值. 脱字符(^)是块的语法标记.按照我们熟悉的参数语法规约所定 ...

  7. form提交xml文件

    --为何ajax提交不了xml?--原因:Request.Form["Data"]这种获取参数方式,原本就不是mvc路由参数获取方式,这是Asp.net中webfrom页面获取参数 ...

  8. nuxtJs中直接使用自带的@nuxtjs/axios

    最初我以为在nuxtjs中是需要重新npm install axios,但是其实nuxtjs自己集成了这个数据渲染方法 你只需在nuxt.config.js中配置一下就可以了 modules: [ / ...

  9. Ubuntu16.04彻底卸载MySQL

    删除mysql的数据文件 sudo rm /var/lib/mysql/ -R 删除mysql的配置文件 sudo rm /etc/mysql/ -R 自动卸载mysql(包括server和clien ...

  10. Java基础(认识Java)

    我们要学习Java那么就要首先认识一下Java: Java是什么 Java是由Sun Microsystems公司于1995年5月推出的Java面向对象程序设计语言和Java平台的总称.由James ...