将excel文件转换为txt文件(不带回车符)

时间:2013-06-21 12:18:38

标签: excel vbscript

我想将excel文件转换为制表符限制的txt文件(没有回车符)。目前我正在使用脚本(在此论坛中找到)将大量excel文件转换为.txt文件。

脚本是

    ' @file:    xl2tab.vbs
' @author:  stephen brown - sb09d@fsu.edu
' @date:    2009-Dec-10
' 
' @description: mass convert excel files to tab-delimited files
'
' @usage:   place in top-level directory where excel files are contained and double-click.
'           script will recursively access all subdirectories and convert each excel file to
'           tab delimited file. All output will be in "output" folder, which retains structure
'           of original directories

Dim saveDirBase

set fso = CreateObject("Scripting.FileSystemObject")
set shell = CreateObject("WScript.Shell")
set objExcel = CreateObject("Excel.Application")

set top = fso.GetFolder(shell.CurrentDirectory)
saveDirBase = top & "\" & "output"

Sub TraverseFolders(path)
    set folder = fso.GetFolder(path)

    XL2Tab(folder)

    For each item in folder.SubFolders
        If item.Path <> saveDirBase Then
            Call TraverseFolders(item.Path)
        End If
    Next

    set folder = Nothing
End Sub

Sub XL2Tab(folder)
    Dim saveDir
    set files = folder.Files

    If folder.Name <> top.Name Then
        saveDir = saveDirBase & "\" & folder.Name
    Else
        saveDir = saveDirBase
    End If

    If fso.FolderExists(saveDir) = False Then
        fso.CreateFolder(saveDir)   
    End If

    For each file In files
        If file.Name <> Wscript.ScriptName Then
            objExcel.Application.DisplayAlerts = False
            Set objWorkbook = objExcel.Workbooks.open(folder.Path & "\" & file.Name)   
            objWorkbook.SaveAs saveDir & "\" & file.Name & ".txt", -4158    
            objWorkbook.close
            objExcel.Application.DisplayAlerts = True
        End If
    Next
End Sub

If fso.FolderExists(saveDirBase) = False Then
    fso.CreateFolder(saveDirBase)   
End If

Call TraverseFolders(top)

在转换之前,我想删除每个excel文件中的回车。

请指导我任何人......!

1 个答案:

答案 0 :(得分:1)

嗨如果您在转换文件后尝试删除回车符,请将以下过程添加到代码

 sub RemoveCarriage(FileN)
 Const ForReading = 1
 Const ForWriting = 2
 Set objFSO = CreateObject("Scripting.FileSystemObject")
 Set objFile = objFSO.OpenTextFile(FileN, ForReading)
 strText = objFile.ReadAll
 objFile.Close
 strNewText = Replace(strText, chr(013) & chr(010), "") 
 ' chr(010) = line feed chr(013) = carriage return
 Set objFile = objFSO.OpenTextFile(FileN, ForWriting)
 objFile.WriteLine strNewText
 objFile.Close 
 End sub

关闭工作簿后立即调用程序内部的forloop程序       objWorkbook.close

 RemoveCarriage(file.Name & ".txt")