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

zhangop9

原文件的内容如下，想转换为表格文件，冒号后是数据，请转为表格来编辑，编辑好后还原成这个样，这只有两个人，实际上有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次。

@echo off
::文件名:telconvert.bat
::用法:
::文本文件扩展名固定为.txt，表格文件扩展名固定为.csv
::1.文本转换为表格
::  在命令行下输入:telconvert.bat 文本文件名 表格文件名
::  如:telconvert.bat contact.txt contact.csv
::  也可直接将文本文件拖至bat文件上，此时将自动生成同名表格文件(仅扩展名不同)
::2.表格转换为文本
::  在命令行下输入:telconvert.bat 表格文件名 文本文件名
::  如:telconvert.bat contact.csv contact.txt
::  也可直接将表格文件拖至bat文件上，此时将自动生成同名文本文件(仅扩展名不同)
setlocal enabledelayedexpansion
set "tab=	"
if "%1"=="" (set/p source=请输入要转换的文件名：) else set "source=%1"
if "%source:~-4%"==".txt" (set destex=.csv&set go=1) else (
  if "%source:~-4%"==".csv" (set destex=.txt&set go=2) else (
    echo,源文件格式不正确！&pause>nul&exit/b
))
if "%2"=="" (set "dest=%~n1%destex%") else set "dest=%2"
if not %dest:~-4%==%destex% echo,目标文件格式不正确!&pause>nul&exit/b
goto convert%go%
:convert1
echo,正在转换，请稍后...
set n=
(for /f "usebackq skip=1 tokens=1* delims=:" %%a in ("%source%") do (
  if "%%a"=="----------" set/a n+=1
  if !n! equ 0 (set/p=%%a,<nul) else goto :next1
))>%dest%
:next1
(for /f "usebackq tokens=1* delims=:" %%i in ("%source%") do (
  if "%%j"=="" (set two=#) else set "two=%%j"
  if not "%%i"=="----------" (set/p=!two!,<nul) else echo,
))>>%dest%
start "" "%dest%"
goto :eof
:convert2
echo,正在转换，请稍后...
set/p head=<"%source%"
set n=
for %%a in (%head%) do set/a n+=1&set "head!n!=%%a"
(for /f "usebackq skip=1 delims=" %%i in ("%source%") do (
  echo,----------
  set str="%%i"&set "str=!str:,=" "!"&set m=
  for %%m in (!str!) do (
    set/a m+=1
    if "%%~m"=="#" (set show=) else set "show=%%~m"
    if !m! leq %n% for %%n in (!m!) do echo,!head%%n!:!show!
  )
))>%dest%
echo,---------->>"%dest%"
start "" "%dest%"
复制代码

zhangop9

回复 3# broly


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

zhangop9

回复 2# sxw


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

weichenxiehou

回复 1# zhangop9
代码以“----------”作为判断标准，所以不要告诉我这个是你为了表达而刻意添加的。。。

@echo off
::文件名:telconvert.bat
::用法:
::文本文件扩展名固定为.txt，表格文件扩展名固定为.xls
::1.文本转换为表格
::  在命令行下输入:telconvert.bat 文本文件名 表格文件名
::  如:telconvert.bat contact.txt contact.xls
::  也可直接将文本文件拖至bat文件上，此时将自动生成同名表格文件(仅扩展名不同)
::2.表格转换为文本
::  在命令行下输入:telconvert.bat 表格文件名 文本文件名
::  如:telconvert.bat contact.xls contact.txt
::  也可直接将表格文件拖至bat文件上，此时将自动生成同名文本文件(仅扩展名不同)
setlocal enabledelayedexpansion
set "tab=	"
if "%1"=="" (set/p source=请输入要转换的文件名：) else set "source=%1"
if "%source:~-4%"==".txt" (set destex=.xls&set go=1) else (
  if "%source:~-4%"==".xls" (set destex=.txt&set go=2) else (
    echo,源文件格式不正确！&pause>nul&exit/b
))
if "%2"=="" (set "dest=%~n1%destex%") else set "dest=%2"
if not %dest:~-4%==%destex% echo,目标文件格式不正确!&pause>nul&exit/b
goto convert%go%
:convert1
echo,正在转换，请稍后...
set n=
(for /f "usebackq skip=1 tokens=1* delims=:" %%a in ("%source%") do (
  if "%%a"=="----------" set/a n+=1
  if !n! equ 0 (set/p=%%a%tab%<nul) else goto :next1
))>%dest%
:next1
(for /f "usebackq tokens=1* delims=:" %%i in ("%source%") do (
  if not "%%i"=="----------" (set/p=%%j%tab%<nul) else echo,
))>>%dest%
start "" "%dest%"
goto :eof
:convert2
set/p head=<"%source%"
set n=
for %%a in (%head%) do set/a n+=1&set "head!n!=%%a"
(for /f "usebackq skip=1 delims=" %%i in ("%source%") do (
  echo,----------
  set str="%%i"&set "str=!str:%tab%=" "!"&set m=
  for %%m in (!str!) do (
    set/a m+=1
    if !m! leq %n% for %%n in (!m!) do echo,!head%%n!:%%~m
  )
))>%dest%
echo,---------->>"%dest%"
start "" "%dest%"
复制代码

broly

'By Broly 
'From http://bbs.bathome.net/

Dim fso,f,choice
Dim xlsPath,txtPath,strText,target

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

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

Set fso = CreateObject("Scripting.FileSystemObject")

Select Case choice
	Case 1:
		If Not fso.FileExists(xlsPath) Then CreateXlsFile(xlsPath)
		strText = GetText(txtPath)
		WriteExcel xlsPath,strText
		MsgBox "Succeed."
		
	Case 2:
		Set f = fso.OpenTextFile(target,8,True)
		f.Write GetExcelInfo(xlsPath)
		f.Close
		Set f = Nothing
		MsgBox "Succeed."
		
	Case Else:
		MsgBox "Wrong choice."
		
End Select

Set fso = Nothing


Function CreateXlsFile(Path)
	Dim objExcel
	Set objExcel = CreateObject("Excel.Application")
	objExcel.Workbooks.Add()
	objExcel.ActiveWorkbook.SaveAs Path
	objExcel.Quit
	Set objExcel = Nothing
End Function

Function GetText(Path)
	Set f = fso.OpenTextFile(Path,1,False)
	If Not f.AtEndOfStream Then
		GetText = f.ReadAll
	End If
	f.Close
	Set f = Nothing
End Function

Function WriteExcel(Path,strText)
	Dim oExcel,oWorkBooks,oWorkSheet
	Dim arr,i,arr2
	
	arr = Split(strText,vbCrLf,-1,1)
	Set oExcel = CreateObject("Excel.Application")
	Set oWorkBooks = oExcel.Workbooks.Open(Path)
	Set oWorkSheet = oWorkBooks.Sheets(1)
	
	oWorkSheet.Activate
	oWorkSheet.Columns(1).ColumnWidth = 45
	oWorkSheet.Columns(2).ColumnWidth = 35
	For i = 0 To UBound(arr)
		arr2 = Split(arr(i),":",-1,1)
		ReDim Preserve arr2(2)
		If InStr(arr2(0),"-----") = 0 And _
			arr2(0) <> "" _
		Then
			oWorkSheet.Cells(i+1,1).Value = arr2(0) & ":"
		Else 
			oWorkSheet.Cells(i+1,1).Value = arr2(0)
		End If
		oWorkSheet.Cells(i+1,2).Value = arr2(1)
	Next
	
	oWorkBooks.Save
	oWorkBooks.Close
	oExcel.Quit
	
	Set oExcel = Nothing
	Set oWorkBooks = Nothing 
	Set oWorkSheet = Nothing
End Function

Function GetExcelInfo(Path)
	Dim oExcel,oWorkBooks,oWorkSheet
	Dim i,strText
	
	Set oExcel = CreateObject("Excel.Application")
	Set oWorkBooks = oExcel.Workbooks.Open(Path)
	Set oWorkSheet = oWorkBooks.Sheets(1)
	
	oWorkSheet.Activate
	i = 1
	Do While oWorkSheet.Cells(i,1).Value <> ""
		strText = strText & vbCrLf _
			& oWorkSheet.Cells(i,1).Value _
			& oWorkSheet.Cells(i,2).Value
		i = i + 1
	Loop
	
	oWorkBooks.Close
	oExcel.Quit
	
	GetExcelInfo = strText
	
	Set oExcel = Nothing
	Set oWorkBooks = Nothing 
	Set oWorkSheet = Nothing
End Function
复制代码

sxw

请转为表格来编辑，编辑好后还原成这个样

是什么意思？