批量转换文本文件到Excel .xlsx并使用VBA将文本转换为列

时间:2016-08-09 10:56:29

标签: excel vba text

我有以下程序批量转换文本到excel(xlsx)

Sub LoopAllFiles()

    Dim sPath As String, sDir As String

    sPath = "C:\Users\DNA\Desktop\Test Convert\"

    If Right(sPath, 1) <> "\" Then sPath = sPath & "\"

    sDir = Dir$(sPath & "*.txt", vbNormal)
    Do Until Len(sDir) = 0
        Workbooks.Open (sPath & sDir)
        With ActiveWorkbook
            .SaveAs Filename:=Left(.FullName, InStrRev(.FullName, ".")) & "xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
            .Close
        End With

        sDir = Dir$
    Loop

End Sub

但是,我有使用管道分隔符将文本转换为列的问题。我已经开发了一些语法,但我不知道如何将它与转换器脚本结合起来。

Selection.TextToColumns DataType:=xlDelimited, _ TextQualifier:=xlTextQualifierNone, Other:=True, _
OtherChar:="|", FieldInfo:=xlTextFormat

愿你们大家帮忙。

谢谢。

2 个答案:

答案 0 :(得分:0)

请尝试使用OpenText代替Open,有关详细参考,请参阅here

Workbooks.OpenText filename:=sPath & sDir, dataType:=xlDelimited, tab:=True, Other:=True, OtherChar:="|"

答案 1 :(得分:0)

尝试使用以下

Sub LoopAllFiles()
    Dim sPath As String, sDir As String
    sPath = "C:\work\"
    If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
    sDir = Dir$(sPath & "*.txt", vbNormal)
    Do Until Len(sDir) = 0
        Workbooks.Open (sPath & sDir)
        With ActiveWorkbook
            Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
                Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
                :="|", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
            .SaveAs Filename:=Left(.FullName, InStrRev(.FullName, ".")) & "xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
            .Close
        End With
        sDir = Dir$
    Loop
End Sub