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