把<em>EXCEL</em>表格中的内容转换成<em>TXT</em>

Set d = fs.CreateTextFile(desk & "\" & ActiveSheet.Name & ".txt", True) 当前工作自表名知来命名道
Set d = fs.CreateTextFile(desk & "\" & ActiveWorkbook.Name & ".txt", True)当前工作簿名来命名

ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\test\桌面百度\Book1.csv", _
FileFormat:=xlCSV, _
CreateBackup:=False
其实就是问另答存为专csv文件属
可以扩e79fa5e98193e58685e5aeb9333展多科的：
Sub test()
Dim arr, i%, j%, tmp$
Set d = CreateObject("Scripting.Dictionary")
arr = ActiveSheet.[a1].CurrentRegion
For i = 2 To UBound(arr)
tmp = ""
If d.exists(arr(i, 1)) = False Then
d(arr(i, 1)) = arr(1, 2)
For j = 3 To UBound(arr, 2)
d(arr(i, 1)) = d(arr(i, 1)) & vbTab & arr(1, j)
Next
End If
For j = 2 To UBound(arr, 2)
If tmp = "" Then tmp = arr(i, j) Else tmp = tmp & vbTab & arr(i, j)
Next
d(arr(i, 1)) = d(arr(i, 1)) & vbCrLf & tmp
Next
a = d.keys: b = d.Items
For i = 0 To d.Count - 1
Open ThisWorkbook.Path & "\" & a(i) & ".txt" For Output As #1
Print #1, b(i)
Close #1
Next
MsgBox "已完成，生成文件在本文件同目录下。"
End Sub

Const Filename = "d:\1.txt"
Sub 复制e79fa5e98193e4b893e5b19e331Excel表格到Text文件()
On Error Resume Next
    Dim srcRng As Range, destRng As Range, textWorkBook As Workbook, wb As Workbook
    Application.DisplayAlerts = False
    
    '打开Text文件前，保存当前活动的工作薄对象
    Set wb = ActiveWorkbook
    Set srcRng = wb.ActiveSheet.UsedRange
    If Dir(Filename) = "" Then
        '如果Text文件不存在，新建一个工作薄，粘贴区域从A1开始
        Set textWorkBook = Workbooks.Add
        Set destRng = textWorkBook.Sheets(1).Range("A1")
    Else
        '通过Workbooks的OpenText方法，打开Text文件
        Workbooks.OpenText Filename:=Filename
        If Err Then
            MsgBox "打开文件 " & Filename & "出错。错误信息如下：" & vbCrLf & vbcrlr & Err.Description
            Exit Sub
        End If
        
        Set textWorkBook = ActiveWorkbook
        '查找粘贴开始位置，即现有数据的最后一行的下一行
        '为了防止是空表时，end操作会定位到最后一行
        Set destRng = textWorkBook.Sheets(1).Range("A1").End(xlDown).Offset(1)
        If Err Then
            Set destRng = textWorkBook.Sheets(1).Range("A1")
        End If
    End If
    
    textWorkBook.Windows(1).Visible = False '隐藏Text文件的窗口，既可以达到隐藏打开，保存和关闭。
    srcRng.Copy destRng  '表的使用区域复制到Text文件的工作薄，指定位置
    
    '使用Workbook的SaveAs方法，通过指定FileFormat参数为xlText，将工作薄另存为Text文件。
    textWorkBook.SaveAs Filename:=Filename, FileFormat:=xlText
    textWorkBook.Close SaveChanges:=True
    Application.DisplayAlerts = True
End Sub
Sub 复制Text文件到Excel表格()
On Error Resume Next
    Dim destRng As Range, textWorkBook As Workbook, wb As Workbook
    Application.DisplayAlerts = False
    
    '打开Text文件前，保存当前活动的工作薄对象
    Set wb = ActiveWorkbook
    
    '查找粘贴开始位置，即现有数据的最后一行的下一行
    '为了防止是空表时，end操作会定位到最后一行
    Set destRng = wb.ActiveSheet.Range("A1").End(xlDown).Offset(1)
    If Err Then
        Set destRng = wb.ActiveSheet.Range("A1")
        Err.Clear
    End If
    
    If Dir(Filename) = "" Then
        'Text文件不存在
        MsgBox "文件 " & Filename & "不存在！"
        Exit Sub
    Else
        '通过Workbooks的OpenText方法，打开Text文件
        Workbooks.OpenText Filename:=Filename
        If Err Then
            MsgBox "打开文件 " & Filename & "出错。错误信息如下：" & vbCrLf & vbcrlr & Err.Description
            Exit Sub
        End If
        
        Set textWorkBook = ActiveWorkbook
    End If
    
    textWorkBook.Windows(1).Visible = False '隐藏Text文件的窗口，既可以达到隐藏打开，保存和关闭。
    textWorkBook.Sheets(1).UsedRange.Copy destRng  '表的使用区域复制到Text文件的工作薄，指定位置
    
    '关闭Text文件。
    textWorkBook.Close SaveChanges:=False
    Application.DisplayAlerts = True
End Sub

使用workbooks的OpenText方法来打开Text文件，然后可以向操作Excel工作表来操作Text文件。