Sub 另存本表为TXT文件()
    Dim s As String
    Dim FullName As String, rng As Range
    Application.ScreenUpdating = False
    FullName = (ActiveSheet.Name & ".txt")   '以当前表名为TXT文件名
    '   FullName = Replace(ThisWorkbook.FullName, ".xls", ".txt")  '以当前文件名为TXT文件名
    '   FullName = Replace(ThisWorkbook.FullName, ".xls", ActiveSheet.Name & ".txt")  '以文件名&表名为TXT文件名
    Open FullName For Output As #1    '以读写方式打开文件，每次写内容都会覆盖原先的内容
    '参考帮助，fullname为文件全名
    For Each rng In Range("a1").CurrentRegion
        s = s & IIf(s = "", "", "|") & rng.Value
        If rng.Column = Range("a1").CurrentRegion.Columns.Count Then
            Print #1, s & "|"   '把数据写到文本文件里
            s = ""
        End If
    Next
    Close #1    '关闭文件
    Application.ScreenUpdating = True
    MsgBox "数据已导入文本"
End Sub

Sub 另存本表为TXT文件()
    Dim s As String
    Dim FullName As String, rng As Range
    Application.ScreenUpdating = False
    FullName = (ActiveSheet.Name & ".txt")   '以当前表名为TXT文件名
    '   FullName = Replace(ThisWorkbook.FullName, ".xls", ".txt")  '以当前文件名为TXT文件名
    '   FullName = Replace(ThisWorkbook.FullName, ".xls", ActiveSheet.Name & ".txt")  '以文件名&表名为TXT文件名
    Open FullName For Output As #1    '以读写方式打开文件，每次写内容都会覆盖原先的内容
    '参考帮助，fullname为文件全名
    For Each rng In Range("a1").CurrentRegion
        s = s & IIf(s = "", "", "|") & rng.Value
        If rng.Column = Range("a1").CurrentRegion.Columns.Count Then
            Print #1, s & "|"   '把数据写到文本文件里
            s = ""
        End If
    Next
    Close #1    '关闭文件
    Application.ScreenUpdating = True
    MsgBox "数据已导入文本"
End Sub