[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖
iq301

Rank: 1

帖子
43 
积分
78 
技术
0  
捐助
0  
注册时间
2014-2-16 
1楼 跳转到 » 倒序看帖
打印
tT
发表于 2014-6-9 23:55 | 只看该作者

[问题求助] [已解决]VBS如何将txt文本数据按指定样式导入/生成Excel表格？

本帖最后由 pcl_test 于 2016-7-27 20:50 编辑

EXCEL 读取txt文本数据  

在一个txt文本文件中存有一下格式数据

Your Merchant Order ID: # xxxxxxx
Purchase Date: February 2, 2009 10:17:30 AM PST
Shipping Service: Standard
Buyer Name: John Doe
Buyer E-mail: [email]none@none.com[/email]

Your Merchant Order ID: # xxxxxxx
Purchase Date: February 2, 2009 10:17:30 AM PST
Shipping Service: Standard
Buyer Name: John Doe
Buyer E-mail: [email]none@none.com[/email]
希望转换数据到excel文件中，并在一行显示同一记录。

Order ID        PurchaseDate        ShippingService        BuyerName        BuyerE-mail
# xxxxxxx        February 2, 2009 10        Standard        John Doe        [email]none@none.com[/email]
# xxxxxxx        February 2, 2009 10        Standard        John Doe        [email]none@none.com[/email]
  1. Sub DataRead()

  2.   Set fs = CreateObject("Scripting.FileSystemObject")

  3.   Open ActiveWorkbook.Path & "\" & "ok.txt" For Input As #1

  4.   i = 2

  5.   Do While Not EOF(1)

  6.         Line Input #1, txt

  7.         Dim a

  8.         a = Split(txt, ":")

  9.         If InStr(txt, "Order ID") > 0 Then

  10.                 Cells(i, 1) = Trim(a(1))

  11.         ElseIf InStr(txt, "Purchase Date") > 0 Then

  12.                 Cells(i, 2) = Trim(a(1))

  13.         ElseIf InStr(txt, "Shipping Service") > 0 Then

  14.                 Cells(i, 3) = Trim(a(1))

  15.         ElseIf InStr(txt, "Buyer Name") > 0 Then

  16.                 Cells(i, 4) = Trim(a(1))

  17.         ElseIf InStr(txt, "Buyer E-mail") > 0 Then

  18.                 Cells(i, 5) = Trim(a(1))

  19.                 i = i + 1

  20.         End If

  21.   Loop

  22.   Close #1

  23.   End Sub
复制代码
上面代码，编译时，  Open ActiveWorkbook.Path & "\" & "ok.txt" For Input As #1 这句提示错误，语句未结束。求解
1

评分人数

    • Batcher: 感谢给帖子标题标注[已解决]字样PB + 2
收藏 分享

CrLf

Rank: 8Rank: 8

帖子
6388 
积分
18831 
技术
978  
捐助
100  
注册时间
2010-10-9 
2楼
发表于 2014-6-10 00:15 | 只看该作者
本帖最后由 CrLf 于 2014-6-10 00:16 编辑

vbs 和 vba 不一样，不能直接套用，可以参考下别人怎么写：
http://blog.csdn.net/chentaocba/article/details/7907800
1

评分人数

链接：在线第三方命令行工具下载   bat、vbs、js 原生混编

TOP

iq301

Rank: 1

帖子
43 
积分
78 
技术
0  
捐助
0  
注册时间
2014-2-16 
3楼
发表于 2014-6-11 00:38 | 只看该作者
回复 2# CrLf


    谢谢分享。

TOP

pcl_test

Rank: 8Rank: 8

帖子
3041 
积分
5330 
技术
684  
捐助
0  
注册时间
2014-10-19 
4楼
发表于 2016-7-27 21:58 | 只看该作者 
  1. Set fso = CreateObject("Scripting.FileSystemObject")

  2. Set ExcelApp = CreateObject("Excel.Application")

  3. ExcelApp.Visible = True 

  4. Set objBook= ExcelApp.Workbooks.Add

  5. str = split("Order ID|Purchase Date|Shipping Service|Buyer Name|Buyer E-mail", "|")

  6. ExcelApp.WorkSheets(1).Activate

  7. For i=0 to Ubound(str)

  8.     ExcelApp.Cells(1, i+1) = str(i)

  9. Next

  10. 

  11. i=1

  12. Set f = fso.OpenTextFile("文本.txt", 1)

  13. Do While f.AtEndOfStream <> true

  14.     line = f.ReadLine

  15.     If InStr(line, str(0)) >0 Then i=i+1:ExcelApp.Cells(i, 1) = split(line, ":")(1)

  16.     If InStr(line, str(1)) >0 Then ExcelApp.Cells(i, 2) = split(line, ":")(1)

  17.     If InStr(line, str(2)) >0 Then ExcelApp.Cells(i, 3) = split(line, ":")(1)

  18.     If InStr(line, str(3)) >0 Then ExcelApp.Cells(i, 4) = split(line, ":")(1)

  19.     If InStr(line, str(4)) >0 Then ExcelApp.Cells(i, 5) = split(line, ":")(1)

  20. Loop

  21. 

  22. objBook.SaveAs(fso.GetFolder(".").Path&"\新建.xls")

  23. objBook.Close

  24. ExcelApp.Quit
复制代码

TOP

zhangop9

Rank: 2

帖子
119 
积分
169 
技术
1  
捐助
0  
注册时间
2010-12-16 
5楼
发表于 2020-11-25 12:16 | 只看该作者
留个记号，答题

TOP

返回列表