社区首页 >专栏 >VBA代码：将Excel保存为文本文件的几段代码

VBA代码：将Excel保存为文本文件的几段代码

fanjy

发布于 2024-01-02 09:47:45

46500

代码可运行

文章被收录于专栏：完美Excel完美Excel

运行总次数：0

代码可运行

标签：VBA

下面的代码将输出一个名为“Test.txt”的文本文件，其中包含常量delimiter中指定的任何分隔符（在本示例中为管道符号）。注意，它可以是多个字符：

Public Sub CharacterSV()
 Const DELIMITER As String = "|"
 Dim myRecord As Range
 Dim myField As Range
 Dim nFileNum As Long
 Dim sOut As String
 
 nFileNum = FreeFile
 Open "Test.txt" For Output As #nFileNum
 For Each myRecord In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
   With myRecord
     For Each myField In Range(.Cells, Cells(.Row, Columns.Count).End(xlToLeft))
       sOut = sOut & DELIMITER & myField.Text
     Next myField
     Print #nFileNum, Mid(sOut, 2)
     sOut = Empty
   End With
 Next myRecord
 Close #nFileNum
End Sub

下面的代码导出的文件每个字段周围都有引号。

Public Sub OutputQuotedCSV()
 Const QSTR As String = """"
 Dim myRecord As Range
 Dim myField As Range
 Dim nFileNum As Long
 Dim sOut As String
 
 nFileNum = FreeFile
 Open "File1.txt" For Output As #nFileNum
 For Each myRecord In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
   With myRecord
     For Each myField In Range(.Cells(1), Cells(.Row, Columns.Count).End(xlToLeft))
       sOut = sOut & "," & QSTR & Replace(myField.Text, QSTR, QSTR & QSTR) & QSTR
     Next myField
     Print #nFileNum, Mid(sOut, 2)
     sOut = Empty
   End With
 Next myRecord
 Close #nFileNum
End Sub

下面的代码输出的文本文件不会对引号中有逗号或文本中有双引号的单元格进行修改（注：使用Excel自身功能导出时，会对单元格中包含逗号的内容或者含有双引号的单元格内容自动添加双引号）：

Public Sub TextNoModification()
 Const DELIMITER As String = "," '或者"|", vbTab, 等.
 Dim myRecord As Range
 Dim myField As Range
 Dim nFileNum As Long
 Dim sOut As String
 
 nFileNum = FreeFile
 Open "Test.txt" For Output As #nFileNum
 For Each myRecord In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
   With myRecord
     For Each myField In Range(.Cells(1), Cells(.Row, Columns.Count).End(xlToLeft))
       sOut = sOut & DELIMITER & myField.Text
     Next myField
     Print #nFileNum, Mid(sOut, 2)
     sOut = Empty
   End With
 Next myRecord
 Close #nFileNum
End Sub

有时应用程序需要具有固定宽度字段的输入文件。例如，每个记录可以由一行组成，字段1由20个字符组成，从字符1开始；字段2由10个字符组成，从字符21开始，等等。无论字段中有多少个字符的数据，字段宽度都是恒定的。少于所需字符数的字段必须用空格或其他字符填充。下面的代码将生成一个具有固定字段的文本文件。字段宽度包含在vFieldArray中。通常没有分隔符，但代码允许使用分隔符。

Public Sub FixedFieldTextFile()
 Const DELIMITER As String = "" '通常不包含分隔符
 Const PAD As String = " "   '或其他字符
 Dim vFieldArray As Variant
 Dim myRecord As Range
 Dim nFileNum As Long
 Dim i As Long
 Dim sOut As String
 
 'vFieldArray包含字段长度, 以字符为单位, 从字段1到N
 vFieldArray = Array(20, 10, 15, 4)
 nFileNum = FreeFile
 Open "Test.txt" For Output As #nFileNum
 For Each myRecord In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
   With myRecord
     For i = 0 To UBound(vFieldArray)
       sOut = sOut & DELIMITER & Left(.Offset(0, i).Text & String(vFieldArray(i), PAD), vFieldArray(i))
     Next i
     Print #nFileNum, Mid(sOut, Len(DELIMITER) + 1)
     sOut = Empty
   End With
 Next myRecord
 Close #nFileNum
End Sub