关于VB 提取Word中相关信息
Word文档是这样的：
1、NISSAN MOTOR CO., LTD (日产自动车株式会社)
TLUALYLJ50EXADE4 轿车
发动机：VQ25（NISSAN）
机外净化器：右:1NF**（NISSAN）
左:1NF**（NISSAN）
燃油蒸发控制装置：14950 3Y500（MAHLE TENNEX）
氧传感器：前:211200-7500（DENSO）
后:OZA603-N5（NTK）
BLUALTLV36EXADE4 轿车
发动机：VQ25（NISSAN）
机外净化器：右:1NF**（NISSAN）
左:1NF**（NISSAN）
燃油蒸发控制装置：14950 6N201（MAHLE TENNEX）
氧传感器：前:211200-7500（DENSO）
后:OZA603-N5（NTK）
2、北京现代汽车有限公司
BH7150AY 轿车
发动机：G4EC（北京现代汽车有限公司）
机外净化器：CAE（KEFICO）
燃油蒸发控制装置：31420-3A000（KFTC(可附特汽车零部件制造(北京)有限公司)）
氧传感器：前：39210-22610（KEFICO）
后：39210-22620（KEFICO）
目标成品就是一个类似这下的Excel形式
汽车生产企业批准年批次车型车型名称发动机型号发动机生产厂机外净化器燃油蒸发控制装置氧传感器
江西昌河铃木汽车有限责任公司20101CH7100A3轿车DA465Q-2哈尔滨东安汽车动力股份有限公司7100AF（前）（天津卡达克汽车高新技术公司）7100AR（后）（天津卡达克汽车高新技术公司）18560-50G**（天津市格林利福新技术有限公司）或 18560-50G**（固安县远祥汽车配件厂）前：LSF4.2（联合汽车电子有限公司）后：LSF4（联合汽车电子有限公司）
目前我的代码是这样的：
Dim WDapp As New Word.Application '声明一个Word对象
WDapp.Documents.Open App.Path & "\test.doc" '打开文件
Dim ExcelID As New Excel.Application
Dim newbook As New Excel.Workbook
ExcelID.WorkBooks.Open App.Path & "\test.xls"
Application.Visible = True
WDapp.Selection.MoveDown unit:=wdLine, Count:=5
WDapp.Selection.HomeKey unit:=wdLine '光标移动到行首
WDapp.Selection.EndKey unit:=wdLine, Extend:=wdExtend '结合上一行使用,选中当前行
Dim a As String '存储特殊符号所在字符串的位置
Dim a1 As String '存储特殊符号所在字符串的位置
Dim b As String '特殊字符串
Dim b1 As String '特殊字符串
Dim c As String '特殊字符前的内容
Dim i As Integer 'excel行坐标
Dim j As Integer 'excel的列坐标
i = 2
j = 1
b1 = "、" '特殊字符 、 以其后字符为起始点
a1 = InStr(1, WDapp.Selection.Text, b1, vbTextCompare)
b = "（"
a = InStr(a1, WDapp.Selection.Text, b, vbTextCompare)
c = Mid(WDapp.Selection.Text, a1 + 1, a - 1 - a1)
ExcelID.Cells(i, j) = c
c = Mid(WDapp.Selection.Text, a)
ExcelID.Cells(i, j + 1) = c
WDapp.Selection.MoveDown unit:=wdLine, Count:=1
WDapp.Selection.HomeKey unit:=wdLine '光标移动到行首
WDapp.Selection.EndKey unit:=wdLine, Extend:=wdExtend '结合上一行使用,选中当前行
b = " " '特殊字符为 空格 分开提取车名 和车型
a = InStr(1, WDapp.Selection.Text, b, vbTextCompare)
c = Mid(WDapp.Selection.Text, 1, a - 1)
ExcelID.Cells(i, j + 2) = c '将车名写入下一个单元格
c = Mid(WDapp.Selection.Text, a)
ExcelID.Cells(i, j + 3) = c '将车型写入写一个单元格
WDapp.Selection.MoveDown unit:=wdLine, Count:=1
WDapp.Selection.HomeKey unit:=wdLine '光标移动到行首
WDapp.Selection.EndKey unit:=wdLine, Extend:=wdExtend '结合上一行使用,选中当前行
b1 = "：" '特殊字符 ： 以其后字符为起始点
a1 = InStr(1, WDapp.Selection.Text, b1, vbTextCompare)
b = "（" '特殊字符为 （ 分开提取发动型号 和发动机型厂商
a = InStr(a1, WDapp.Selection.Text, b, vbTextCompare) '不提取前四个字符 发动机：
c = Mid(WDapp.Selection.Text, a1 + 1, a - 1 - a1) '空出 发动机： 相应字符数
ExcelID.Cells(i, j + 4) = c '将发动机型号写入单元格
c = Mid(WDapp.Selection.Text, a)
ExcelID.Cells(i, j + 5) = c '将发动机厂商写入单元格
WDapp.Selection.MoveDown unit:=wdLine, Count:=1
WDapp.Selection.HomeKey unit:=wdLine '光标移动到行首
WDapp.Selection.EndKey unit:=wdLine, Extend:=wdExtend '结合上一行使用,选中当前行
Documents("test.doc").Close '关闭文档
WDapp.Quit '关闭word
问题：
Q1：我现在提取到 机外净化器： 这一块卡主了，没想好怎么样把两行内容写入到一个单元格
Q2：我希望的是，从第二段开始循环起来，但是这个循环我不太会套……
[解决办法]
群中已经介绍给你不少资料了。 你现在应该已经可以开始简单的设计 了。
QQ群 48866293 OFFICE应用挖掘
MS OFFICE(ACCESS\EXCE\WORD等应用技术探讨与交流！技术群,请阅群论坛中的《踢人规则》
[解决办法]
http://download.csdn.net/source/1627134
------解决方案--------------------
这方面的高手都在#3楼的群里，你不去，来不得别人
Do not While Is 燃油蒸发控制装置： strTMP=strTMP & FindsplitCode(这里就是你读取word," 机外净化器：") wend Function FindSplitCode(strCode As String, strCompara As String) As String Dim intPos As Integer, intArrBound As Integer Dim strTmp As String, strResult As String Dim strArrTmp() As String intPos = InStr(1, strCode, strCompare) 'Is关键字出现 If intPos > 1 Then strArrTmp = Split(strCode, ":") '分离关键字记录出现的信息 intArrBound = UBound(strArrTmp) If intArrBound > 0 Then strResult = strArrTmp(intArrBound) '读取关键字记录的信息 End If End If FindSplitCode = strResultEnd Function
[解决办法]
Q2：我希望的是，从第二段开始循环起来，但是这个循环我不太会套……
你个内容是连接的,中间是空行分隔,,你就判断是否空行,
do while 是否为空行 读取word内容, do while not 关键词记录块 调用findsplitcode wend 写入excel wend
