VBA调用fso读取TXT转化EXCEL

TXT转EXCEL

适用TXT样式： 固定分隔符规范TXT数据源

效果：调用对话框选择打开TXT，设置TXT分割符，将转化文件保存到TXT文件同一目录下。如下图：

关于批量txt转化EXCEL：

可以结合Dir语句，遍历选定目下txt文件，再逐个转化成EXCEL文件。调用文件对话框选择目录语句如下：

Sub select_file_directory()
On Error Resume Next
Dim dig As Object
Set dig = Application.FileDialog(msoFileDialogFolderPicker)
With dig
	'从d盘下开始选择，也可以选择其他盘符。
	.InitialFileName = "d:\"
	.Show
	'文件目录
	file_directory = .SelectedItems(1)
End With
Set dig = Nothing
On Error GoTo 0
End Sub

转化代码

Sub txt_to_excel()
'关闭屏幕更新
Application.ScreenUpdating = False
Dim arr()
Dim brr
Dim sep, file_name As String
Dim file_path
Dim fso, f As Object
Dim col, row, i As Long

'设置txt分隔符
sep = "|"
Set fso = CreateObject("scripting.filesystemobject")
'调用文件对话框选择txt文件
file_path = Application.GetOpenFilename("TXT文件,*txt", 1, "请选择目标txt文件~")
If file_path = False Then MsgBox "您已经取消选择文件，点击结束程序~": End
file_name = Split(file_path, "\")(UBound(Split(file_path, "\")))
file_name = Split(file_name, ".")(0)
'从文件路径中截取txt文件名字，用于保存excel命名
Debug.Print file_name	

'如果不存在，怎创建该文件。第三个参数设置true。第二个参数，1是只读，2是写入，3是追加写入
Set f = fso.opentextfile(file_path, 1, True)
'如果文件指针位于 TextStream 文件末，则返回 True；否则如果不为只读则返回 False，只能以只读方式打开，不然会报错。
If f.atendofstream = False Then
    row = 1
    brr = Split(f.readline, sep)
    'txt数据一共有col列
    col = UBound(brr) + 1
    '动态数组只能修改最后一维，数组的第一位“行”固定了，只能到列上扩充，实际还是行坐标，这里还是定义变量row表示数组列。
    ReDim Preserve arr(1 To col, 1 To row)
    For i = 1 To col
    	'分割txt行，赋值到数组
        arr(i, row) = brr(i - 1)
    Next
End If
Do While f.atendofstream = False
    row = row + 1
    brr = Split(f.readline, sep)
    ReDim Preserve arr(1 To col, 1 To row)
    For i = 1 To col
        arr(i, row) = brr(i - 1)
    Next
Loop
'关闭txt对象
f.Close

'新建工作簿，保存txt内容
Set wb = Workbooks.Add
With ActiveSheet
	'转置数组，写入到单元格中。
    [a1].Resize(UBound(arr, 2), UBound(arr, 1)) = Application.WorksheetFunction.Transpose(arr)
End With
'保存工作簿
wb.SaveAs ThisWorkbook.path & "\" & file_name & ".xlsx"
'关闭工作簿
wb.Close True
'恢复屏幕更新
Application.ScreenUpdating = True
MsgBox "Convert successfully!"
End Sub 

OpenTextFile语法：

object.OpenTextFile(filename[, iomode[, create[, format]]])

作用：打开一个指定的文件并返回一个 TextStream 对象，该对象可用于对文件进行读、写、追加操作。

参数说明：

iomode 参数可为下面设置值中的任何值：

• ForReading 1 打开一个只读文件，不能对此文件进行写操作。
• ForWriting 2 打开一个用于写操作的文件。如果和此文件同名的文件已存在，则覆盖以前内容。
• ForAppending 8 打开一个文件并写到文件的尾部。
  create 可选的，它表示如果指定的 filename 不存在是否可以创建一个新文件。如果创建新文件，其值为 True。若不创建文件其值为 False。缺省值为 False。
  Format 参数可为下面设置值中的任何值：
• TristateUseDefault –2 使用系统缺省打开文件。
• TristateTrue –1 以 Unicode 格式打开文件。
• TristateFalse 0 以 ASCII 格式打开文件。

判断是否存在文件：
If fso.fileexists("D:\Desktop\test.txt") then

示例：
Set f = fso.OpenTextFile("c:\testfile.txt", 2, True)
或者：
Const ForWriting = 2
Set f = fso.OpenTextFile("c:\testfile.txt", ForWriting, True)
这两者功能是一样的，一个声明了常量，一个直接用数值。都是在C盘创建文件testfile.txt（如不存在），或以写的方式打开（如存在）。

读取文件

Set fso = CreateObject("Scripting.FileSystemObject")
打开txt文件
Set f = fso.OpenTextFile("D:\Desktop\test.txt", 1, True)
f.readall一次性读取所有内容。
读取第一行的前 12 个字符并且将它赋值给变量 strText
strText = objTextFile.Read(12)
读取一行并且将它赋值给变量strText
strText = objTextFile.ReadLine
跳过前面的 12 字节 从第 13 个字符开始
objTextFile.Skip(12)
objTextFile.readline
先读第一行，然后读取第三行。跳过了第二行
strText = objTextFile.Readline
objTextFile.SkipLine
strText = objTextFile.Readline
示例：

dim arr()
dim temp_arr
i = 1
'如果文件指针位于 TextStream 文件末，则返回 True；否则如果不为只读则返回 False，只能以只读方式打开，不然会报错。
Do While f.atendofstream = False
    temp_arr = Split(f.readline, "|")		'读取“|”分割的txt文件。
    ReDim Preserve arr(1 To 3, 1 To i)
    For col = 1 To 3
        arr(col, i) = temp_arr(col - 1)
    Next
    i = i + 1
Loop
'关闭文件
f.Close

写入

Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile("D:\Desktop\test.txt", 2, True)
如果不存在，创建该文件。第三个参数设置true。第二个参数，1是只读，2是写入，8是追加写入

• 方法-Write：向文本文件中写入数据，不是添加文件到末尾。不会自动换行。
• 方法-WriteLine：向文本文件中写入数据后添加一个换行符号，然后区自动换行的。
• 方法-WriteBlankLines：向文本文件中写入特定数目空白的行。例如如下的代码向文本文件中写入两行独立的文字，然后用空白的行分开：f.writelines(2) 写入两个空行。
  向两个字符中插入一个空格。为了创建一个空格分隔的文件，代码和下面的类似：VbTab
  objTextFile.WriteLine(objService.DisplayName & vbTab & objService.State)