设为首页收藏本站
切换到宽版

 找回密码
 注册
搜索
批处理之家»论坛 › 其他脚本区 › VBS求助&讨论 › [已解决]VBS怎样实现电话簿转换，坚的表格变成横的表格 ...
[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发新帖
查看: 28702|回复: 5

[问题求助] [已解决]VBS怎样实现电话簿转换，坚的表格变成横的表格，谢谢。

[复制链接]
zhangop9
发表于 2011-10-29 23:24:33 | 显示全部楼层 |阅读模式
原文件的内容如下，想转换为表格文件，冒号后是数据，请转为表格来编辑，编辑好后还原成这个样，这只有两个人，实际上有100多条。（说明白一点就是坚的表格变成横的表格）

myText.txt
----------
AccountName:
Anniversary:
AssistantName:
AssistantTelephoneNumber:
Birthday:
Body:
Business2TelephoneNumber:
BusinessAddressCity:
BusinessAddressCountry:
BusinessAddressPostalCode:
BusinessAddressState:
BusinessAddressStreet:
BusinessFaxNumber:
BusinessTelephoneNumber:
CarTelephoneNumber:
Categories:其他
Children:
CompanyName:M.其他
CompanyTelephoneNumber:
CustomerId:
Department:
Email1Address:
Email2Address:
Email3Address:
FileAs:139邮箱
FirstName:139邮箱
GovernmentId:
Home2TelephoneNumber:
HomeAddressCity:
HomeAddressCountry:
HomeAddressPostalCode:
HomeAddressState:
HomeAddressStreet:
HomeFaxNumber:
HomeTelephoneNumber:
IM1Address:
IM2Address:
IM3Address:
ItemId:-2147481866
JobTitle:
LastName:
Manager:
MiddleName:
MobileTelephoneNumber:58139
Nickname:
OfficeLocation:
OtherAddressCity:
OtherAddressCountry:
OtherAddressPostalCode:
OtherAddressState:
OtherAddressStreet:
PagerNumber:
RadioTelephoneNumber:
RingTone:\Extended_Rom\LS\HELLO moto.mp3
Spouse:
Suffix:
Title:
YomiCompanyName:
YomiFirstName:
YomiLastName:
----------
AccountName:
Anniversary:
AssistantName:
AssistantTelephoneNumber:
Birthday:
Body:
Business2TelephoneNumber:
BusinessAddressCity:
BusinessAddressCountry:
BusinessAddressPostalCode:
BusinessAddressState:
BusinessAddressStreet:
BusinessFaxNumber:
BusinessTelephoneNumber:
CarTelephoneNumber:
Categories:卫22
Children:
CompanyName:卫22
CompanyTelephoneNumber:
CustomerId:
Department:
Email1Address:
Email2Address:
Email3Address:
FileAs:艾小
FirstName:艾小
GovernmentId:
Home2TelephoneNumber:
HomeAddressCity:
HomeAddressCountry:
HomeAddressPostalCode:
HomeAddressState:
HomeAddressStreet:
HomeFaxNumber:
HomeTelephoneNumber:
IM1Address:
IM2Address:
IM3Address:
ItemId:-2147481593
JobTitle:
LastName:
Manager:
MiddleName:
MobileTelephoneNumber:1388600000
Nickname:
OfficeLocation:
OtherAddressCity:
OtherAddressCountry:
OtherAddressPostalCode:
OtherAddressState:
OtherAddressStreet:
PagerNumber:
RadioTelephoneNumber:
RingTone:\Extended_Rom\LS\疯狂笑蛙.mp3
Spouse:
Suffix:
Title:
YomiCompanyName:
YomiFirstName:
YomiLastName:



转换为：myText.csv
AccountName,Anniversary,AssistantName,AssistantTelephoneNumber,Birthday,Body,Business2TelephoneNumber,BusinessAddressCity,BusinessAddressCountry,BusinessAddressPostalCode,BusinessAddressState,BusinessAddressStreet,BusinessFaxNumber,BusinessTelephoneNumber,CarTelephoneNumber,Categories,Children,CompanyName,CompanyTelephoneNumber,CustomerId,Department,Email1Address,Email2Address,Email3Address,FileAs,FirstName,GovernmentId,Home2TelephoneNumber,HomeAddressCity,HomeAddressCountry,HomeAddressPostalCode,HomeAddressState,HomeAddressStreet,HomeFaxNumber,HomeTelephoneNumber,IM1Address,IM2Address,IM3Address,ItemId,JobTitle,LastName,Manager,MiddleName,MobileTelephoneNumber,Nickname,OfficeLocation,OtherAddressCity,OtherAddressCountry,OtherAddressPostalCode,OtherAddressState,OtherAddressStreet,PagerNumber,RadioTelephoneNumber,RingTone,Spouse,Suffix,Title,YomiCompanyName,YomiFirstName,YomiLastName
,,,,,,,,,,,,,,,其他,,M.其他,,,,,,,139邮箱,139邮箱,,,,,,,,,,,,,-2147481866,,,,,58139,,,,,,,,,,\Extended_Rom\LS\HELLO moto.mp3,,,,,,
,,,,,,,,,,,,,,,卫22,,卫22,,,,,,,艾小,艾小,,,,,,,,,,,,,-2147481593,,,,,13886000000,,,,,,,,,,\Extended_Rom\LS\疯狂笑蛙.mp3,,,,,,
最后完美解决，谢谢版主搞了一晚上，前后改了5次。
  1. @echo off
  2. ::文件名:telconvert.bat
  3. ::用法:
  4. ::文本文件扩展名固定为.txt，表格文件扩展名固定为.csv
  5. ::1.文本转换为表格
  6. ::  在命令行下输入:telconvert.bat 文本文件名 表格文件名
  7. ::  如:telconvert.bat contact.txt contact.csv
  8. ::  也可直接将文本文件拖至bat文件上，此时将自动生成同名表格文件(仅扩展名不同)
  9. ::2.表格转换为文本
  10. ::  在命令行下输入:telconvert.bat 表格文件名 文本文件名
  11. ::  如:telconvert.bat contact.csv contact.txt
  12. ::  也可直接将表格文件拖至bat文件上，此时将自动生成同名文本文件(仅扩展名不同)
  13. setlocal enabledelayedexpansion
  14. set "tab=        "
  15. if "%1"=="" (set/p source=请输入要转换的文件名：) else set "source=%1"
  16. if "%source:~-4%"==".txt" (set destex=.csv&set go=1) else (
  17.   if "%source:~-4%"==".csv" (set destex=.txt&set go=2) else (
  18.     echo,源文件格式不正确！&pause>nul&exit/b
  19. ))
  20. if "%2"=="" (set "dest=%~n1%destex%") else set "dest=%2"
  21. if not %dest:~-4%==%destex% echo,目标文件格式不正确!&pause>nul&exit/b
  22. goto convert%go%
  23. :convert1
  24. echo,正在转换，请稍后...
  25. set n=
  26. (for /f "usebackq skip=1 tokens=1* delims=:" %%a in ("%source%") do (
  27.   if "%%a"=="----------" set/a n+=1
  28.   if !n! equ 0 (set/p=%%a,<nul) else goto :next1
  29. ))>%dest%
  30. :next1
  31. (for /f "usebackq tokens=1* delims=:" %%i in ("%source%") do (
  32.   if "%%j"=="" (set two=#) else set "two=%%j"
  33.   if not "%%i"=="----------" (set/p=!two!,<nul) else echo,
  34. ))>>%dest%
  35. start "" "%dest%"
  36. goto :eof
  37. :convert2
  38. echo,正在转换，请稍后...
  39. set/p head=<"%source%"
  40. set n=
  41. for %%a in (%head%) do set/a n+=1&set "head!n!=%%a"
  42. (for /f "usebackq skip=1 delims=" %%i in ("%source%") do (
  43.   echo,----------
  44.   set str="%%i"&set "str=!str:,=" "!"&set m=
  45.   for %%m in (!str!) do (
  46.     set/a m+=1
  47.     if "%%~m"=="#" (set show=) else set "show=%%~m"
  48.     if !m! leq %n% for %%n in (!m!) do echo,!head%%n!:!show!
  49.   )
  50. ))>%dest%
  51. echo,---------->>"%dest%"
  52. start "" "%dest%"
复制代码

评分

参与人数 1PB +2 收起 理由
broly + 2 感谢给帖子标题标注[已解决]字样

查看全部评分

回复

举报

sxw
发表于 2011-10-29 23:43:41 | 显示全部楼层
请转为表格来编辑，编辑好后还原成这个样

是什么意思？
回复

举报

broly
发表于 2011-10-30 02:26:27 | 显示全部楼层
  1. 'By Broly
  2. 'From http://bbs.bathome.net/

  4. Dim fso,f,choice
  5. Dim xlsPath,txtPath,strText,target

  7. xlsPath = "d:\myExcel.xls"
  8. txtPath = "d:\myText.txt"
  9. target = "d:\tatget.txt"

  11. choice = InputBox("1.TXT -> Excel" & vbCrLf & "2.Excel -> TXT","请选择")

  13. Set fso = CreateObject("Scripting.FileSystemObject")

  15. Select Case choice
  16.         Case 1:
  17.                 If Not fso.FileExists(xlsPath) Then CreateXlsFile(xlsPath)
  18.                 strText = GetText(txtPath)
  19.                 WriteExcel xlsPath,strText
  20.                 MsgBox "Succeed."
  21.                
  22.         Case 2:
  23.                 Set f = fso.OpenTextFile(target,8,True)
  24.                 f.Write GetExcelInfo(xlsPath)
  25.                 f.Close
  26.                 Set f = Nothing
  27.                 MsgBox "Succeed."
  28.                
  29.         Case Else:
  30.                 MsgBox "Wrong choice."
  31.                
  32. End Select

  34. Set fso = Nothing


  37. Function CreateXlsFile(Path)
  38.         Dim objExcel
  39.         Set objExcel = CreateObject("Excel.Application")
  40.         objExcel.Workbooks.Add()
  41.         objExcel.ActiveWorkbook.SaveAs Path
  42.         objExcel.Quit
  43.         Set objExcel = Nothing
  44. End Function

  46. Function GetText(Path)
  47.         Set f = fso.OpenTextFile(Path,1,False)
  48.         If Not f.AtEndOfStream Then
  49.                 GetText = f.ReadAll
  50.         End If
  51.         f.Close
  52.         Set f = Nothing
  53. End Function

  55. Function WriteExcel(Path,strText)
  56.         Dim oExcel,oWorkBooks,oWorkSheet
  57.         Dim arr,i,arr2
  58.        
  59.         arr = Split(strText,vbCrLf,-1,1)
  60.         Set oExcel = CreateObject("Excel.Application")
  61.         Set oWorkBooks = oExcel.Workbooks.Open(Path)
  62.         Set oWorkSheet = oWorkBooks.Sheets(1)
  63.        
  64.         oWorkSheet.Activate
  65.         oWorkSheet.Columns(1).ColumnWidth = 45
  66.         oWorkSheet.Columns(2).ColumnWidth = 35
  67.         For i = 0 To UBound(arr)
  68.                 arr2 = Split(arr(i),":",-1,1)
  69.                 ReDim Preserve arr2(2)
  70.                 If InStr(arr2(0),"-----") = 0 And _
  71.                         arr2(0) <> "" _
  72.                 Then
  73.                         oWorkSheet.Cells(i+1,1).Value = arr2(0) & ":"
  74.                 Else
  75.                         oWorkSheet.Cells(i+1,1).Value = arr2(0)
  76.                 End If
  77.                 oWorkSheet.Cells(i+1,2).Value = arr2(1)
  78.         Next
  79.        
  80.         oWorkBooks.Save
  81.         oWorkBooks.Close
  82.         oExcel.Quit
  83.        
  84.         Set oExcel = Nothing
  85.         Set oWorkBooks = Nothing
  86.         Set oWorkSheet = Nothing
  87. End Function

  89. Function GetExcelInfo(Path)
  90.         Dim oExcel,oWorkBooks,oWorkSheet
  91.         Dim i,strText
  92.        
  93.         Set oExcel = CreateObject("Excel.Application")
  94.         Set oWorkBooks = oExcel.Workbooks.Open(Path)
  95.         Set oWorkSheet = oWorkBooks.Sheets(1)
  96.        
  97.         oWorkSheet.Activate
  98.         i = 1
  99.         Do While oWorkSheet.Cells(i,1).Value <> ""
  100.                 strText = strText & vbCrLf _
  101.                         & oWorkSheet.Cells(i,1).Value _
  102.                         & oWorkSheet.Cells(i,2).Value
  103.                 i = i + 1
  104.         Loop
  105.        
  106.         oWorkBooks.Close
  107.         oExcel.Quit
  108.        
  109.         GetExcelInfo = strText
  110.        
  111.         Set oExcel = Nothing
  112.         Set oWorkBooks = Nothing
  113.         Set oWorkSheet = Nothing
  114. End Function
复制代码
回复

举报

weichenxiehou
发表于 2011-10-30 09:19:28 | 显示全部楼层
回复 1# zhangop9
代码以“----------”作为判断标准，所以不要告诉我这个是你为了表达而刻意添加的。。。

  2. @echo off
  3. ::文件名:telconvert.bat
  4. ::用法:
  5. ::文本文件扩展名固定为.txt，表格文件扩展名固定为.xls
  6. ::1.文本转换为表格
  7. ::  在命令行下输入:telconvert.bat 文本文件名 表格文件名
  8. ::  如:telconvert.bat contact.txt contact.xls
  9. ::  也可直接将文本文件拖至bat文件上，此时将自动生成同名表格文件(仅扩展名不同)
  10. ::2.表格转换为文本
  11. ::  在命令行下输入:telconvert.bat 表格文件名 文本文件名
  12. ::  如:telconvert.bat contact.xls contact.txt
  13. ::  也可直接将表格文件拖至bat文件上，此时将自动生成同名文本文件(仅扩展名不同)
  14. setlocal enabledelayedexpansion
  15. set "tab=        "
  16. if "%1"=="" (set/p source=请输入要转换的文件名：) else set "source=%1"
  17. if "%source:~-4%"==".txt" (set destex=.xls&set go=1) else (
  18.   if "%source:~-4%"==".xls" (set destex=.txt&set go=2) else (
  19.     echo,源文件格式不正确！&pause>nul&exit/b
  20. ))
  21. if "%2"=="" (set "dest=%~n1%destex%") else set "dest=%2"
  22. if not %dest:~-4%==%destex% echo,目标文件格式不正确!&pause>nul&exit/b
  23. goto convert%go%
  24. :convert1
  25. echo,正在转换，请稍后...
  26. set n=
  27. (for /f "usebackq skip=1 tokens=1* delims=:" %%a in ("%source%") do (
  28.   if "%%a"=="----------" set/a n+=1
  29.   if !n! equ 0 (set/p=%%a%tab%<nul) else goto :next1
  30. ))>%dest%
  31. :next1
  32. (for /f "usebackq tokens=1* delims=:" %%i in ("%source%") do (
  33.   if not "%%i"=="----------" (set/p=%%j%tab%<nul) else echo,
  34. ))>>%dest%
  35. start "" "%dest%"
  36. goto :eof
  37. :convert2
  38. set/p head=<"%source%"
  39. set n=
  40. for %%a in (%head%) do set/a n+=1&set "head!n!=%%a"
  41. (for /f "usebackq skip=1 delims=" %%i in ("%source%") do (
  42.   echo,----------
  43.   set str="%%i"&set "str=!str:%tab%=" "!"&set m=
  44.   for %%m in (!str!) do (
  45.     set/a m+=1
  46.     if !m! leq %n% for %%n in (!m!) do echo,!head%%n!:%%~m
  47.   )
  48. ))>%dest%
  49. echo,---------->>"%dest%"
  50. start "" "%dest%"
复制代码

评分

参与人数 1技术 +1 收起 理由
broly + 1 乐于助人

查看全部评分

回复

举报

zhangop9
 楼主| 发表于 2011-10-31 16:11:56 | 显示全部楼层
回复 2# sxw


    就是在表格中编辑，编辑完后，还原成原来的坚表格。
回复

举报

zhangop9
 楼主| 发表于 2020-2-29 19:41:35 | 显示全部楼层
回复 3# broly


以前看不明白，现在看明白了
回复

举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

Archiver|手机版|小黑屋|批处理之家 ( 渝ICP备10000708号 )

GMT+8, 2026-3-17 06:27 , Processed in 0.034985 second(s), 13 queries , File On.

Powered by Discuz! X3.5

© 2001-2026 Discuz! Team.

快速回复 返回顶部 返回列表