|
Sub 导出数据文件()
Dim DestFile As String
Dim FileNum As Integer
Dim ColumnCount As Integer
Dim RowCount As Integer
Dim today As Date
today = Now()
fileNames = Split(ThisWorkbook.Name, ".")
DestFile = ThisWorkbook.Path + "\" + "icbc_" + ActiveSheet.Cells(2, 2).Text + ".txt"
' 提示用户指定目标文件名。
'DestFile = InputBox("请输入导出的数据文件名" & _
'Chr(10) & "(包括所有完整路径和文件的扩展名):", _
'"Quote-Comma Exporter")
' 获取下一个可用的文件句柄编号。
FileNum = FreeFile()
' 关闭错误检查功能。
On Error Resume Next
' 尝试打开目标文件以供输出。
Open DestFile For Output As #FileNum
' 如果出现错误,则报告错误并结束程序。
If Err <> 0 Then
MsgBox "不能打开目标文件 " & DestFile
End
End If
Columns("E:E").NumberFormatLocal = "@"
' 打开错误检查功能。
On Error GoTo 0
' 循环选择的每一行。
For RowCount = 4 To ActiveSheet.UsedRange.Rows.Count - 1
' 循环选择的每一列。
Print #FileNum, "";
For ColumnCount = 1 To ActiveSheet.UsedRange.Columns.Count
If Len(ActiveSheet.Cells(RowCount, "A").Text) <= 0 Then GoTo AA1
If Len(ActiveSheet.Cells(RowCount, "E").Text) <= 0 Then GoTo AA1
If Len(ActiveSheet.Cells(RowCount, ColumnCount).Text) > 0 Then
' 将当前单元格中的文本写入到文件中,文本用引号括起来。
Print #FileNum, ActiveSheet.Cells(RowCount, ColumnCount).Text;
' 检查单元格是否位于最后一列。
Else
Print #FileNum, "";
End If
If ColumnCount = ActiveSheet.UsedRange.Columns.Count Then
' 如果是,则写入一个空行(null)。
Print #FileNum, ""
Else
' 否则,则写入一个|。
Print #FileNum, "|";
End If
' 开始 ColumnCount 循环的下一个迭代。
AA1:
Next ColumnCount
' 开始 RowCount 循环的下一个迭代。
Next RowCount
' 关闭目标文件。
Close #FileNum
MsgBox "数据已经导出到[" + DestFile + "]文件中"
End Sub
增加内容:
1、增加每100条数据存一个txt文件,文件名根据文件递增。比如icbc_1321054_001.txt、icbc_1321054_002.txt
2、每个txt首行是行4的内容。并且C4随该个txt行数变化而变化
3、现VBA生成的txt最后一行是空格,修改后能否没有最后一行空格。
|
|