EXCEL VBA读取多种编码的txt文件

shenjianrong163

对于常用的ANSI、Unicode、UTF-8、GB2312等编码的txt文件，本代码仅提供当前目录下的单个txt文件的读取，先判断txt文件的编码，再根据编码采用不同的读取方法，避免出现乱码的情况。（附件中的txt文件是UTF-8的，大家可以分别另存为别的编码进行测试。）

1. Sub test()
   
2.     Dim i%, j%, s, st, arrByte() As Byte, FileCode$, arr()
   
3.     Application.ScreenUpdating = False
   
4.     Filename = ThisWorkbook.Path & "" & Dir(ThisWorkbook.Path & "" & "*.txt") '获取当前目录下的txt文件
   
5.     If Len(Dir(ThisWorkbook.Path & "" & "*.txt")) Then   '判断是否存在txt文件
   
6.         FileCode = GetFileCode(Filename)  'GetfileCode函数判断txt文件编码
   
7.         If FileCode <> "ANSI or Other" Then   '判断编码
   
8.            Open Filename For Binary Access Read As #1
   
9.            ReDim arrByte(LOF(1) - 1)
   
10.            Get #1, , arrByte
    
11.            Close #1
    
12.            s = Split(ByteToStr(arrByte, FileCode), vbNewLine) '调用ByteToStr函数,s获取UTF-8或Unicode编码的内容
    
13.         Else
    
14.            Open Filename For Input As #1
    
15.            s = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)  's获取ANSI或GB2312编码的内容
    
16.            Close #1
    
17.         End If
    
18.     Else
    
19.         MsgBox "当前目录下没有txt文件!": Exit Sub '当前目录下没有txt文件,退出程序
    
20.     End If
    
21.     If UBound(s) < 0 Then MsgBox "txt文件中没有数据!": Exit Sub  'txt文件中没有内容,退出程序
    
22.     ReDim arr(1 To UBound(s) + 1, 1 To 100) '预设100列
    
23.     For i = 0 To UBound(s)
    
24.         st = Split(s(i), vbTab) '以分隔符号Tab将数组s的内容分割开
    
25.         If UBound(arr, 2) > UBound(st) + 1 And UBound(st) > 0 Then ReDim Preserve arr(1 To UBound(s) + 1, 1 To UBound(st) + 1) '根据数组st中的最大个数重新设置arr的列数
    
26.         For j = 0 To UBound(st)
    
27.             arr(i + 1, j + 1) = st(j)
    
28.         Next
    
29.     Next
    
30.     With Sheets("Sheet1")
    
31.         .UsedRange.ClearContents
    
32.         .[A1].Resize(UBound(arr), UBound(arr, 2)) = arr
    
33.     End With
    
34.     Application.ScreenUpdating = True
    
35.     MsgBox "txt文件读取完成!", "64", "温馨提示"
    
36. End Sub
    
37. Function ByteToStr(arrByte, strCharset As String) As String 'ByteToStr函数读取UTF-8或Unicode编码的内容
    
38.     With CreateObject("Adodb.Stream")
    
39.         .Type = 1
    
40.         .Open
    
41.         .Write arrByte
    
42.         .Position = 0
    
43.         .Type = 2
    
44.         .Charset = strCharset
    
45.         ByteToStr = .Readtext
    
46.         .Close
    
47.     End With
    
48. End Function
    
49. Function GetFileCode(ByVal FilePath As String) '判断txt文件的编码
    
50.     Dim intFile As Integer
    
51.     Dim arrTmp(2) As Byte
    
52.     Dim i As Long
    
53.     intFile = FreeFile
    
54.     Open FilePath For Binary Access Read As #intFile
    
55.     Get #intFile, 1, arrTmp
    
56.     Close #intFile
    
57.     Select Case arrTmp(0) & arrTmp(1)
    
58.         Case "255254"
    
59.             GetFileCode = "Unicode"
    
60.         Case "254255"
    
61.             GetFileCode = "Unicode"  '实为"Unicode Big Endian",为了读取时作为变量将其处理为“Unicode”
    
62.         Case "239187"
    
63.             GetFileCode = "UTF-8"
    
64.         Case Else
    
65.             GetFileCode = "ANSI or Other"
    
66.     End Select
    
67. End Function
    

复制代码

shenjianrong163

请参考附件：



EXCEL VBA读取多种编码的txt文件.rar (13.86 KB, 下载次数: 386)

2020-4-5 15:14 上传

点击文件名下载附件
1

nk0769

上次在微信那篇印象有看到应用本例,忘记在哪了..

shenjianrong163

nk0769 发表于 2020-4-30 08:24
上次在微信那篇印象有看到应用本例,忘记在哪了..

你说的是这个吗?
http://club.excelhome.net/forum. ... 35&pid=10290952

liaoliangbang

感谢分享！！！！

nk0769

shenjianrong163 发表于 2020-5-1 16:03
你说的是这个吗?
http://club.excelhome.net/forum.php?mod=redirect&goto=findpost&ptid=1528435&pid=1 ...

是的,我一时还搜不到,谢谢分享

聆听我心

感谢无私分享！

117365159

感谢大佬分享，这个太实用了！

gwjkkkkk

感谢楼主分享！！！

xvjiex

感谢楼主分享EXCEL VBA读取多种编码的txt文件。