ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 5296|回复: 16

[分享] EXCEL VBA读取多种编码的txt文件

  [复制链接]

TA的精华主题

TA的得分主题

发表于 2020-4-5 15:13 | 显示全部楼层 |阅读模式
对于常用的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
复制代码


评分

8

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-4-5 15:14 | 显示全部楼层
请参考附件:



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

评分

2

查看全部评分

TA的精华主题

TA的得分主题

发表于 2020-4-30 08:24 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
上次在微信那篇印象有看到应用本例,忘记在哪了..

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-5-1 16:03 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
nk0769 发表于 2020-4-30 08:24
上次在微信那篇印象有看到应用本例,忘记在哪了..

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

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2020-5-5 10:20 | 显示全部楼层

TA的精华主题

TA的得分主题

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

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

TA的精华主题

TA的得分主题

发表于 2020-5-7 11:19 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
感谢无私分享!

TA的精华主题

TA的得分主题

发表于 2020-11-18 10:19 | 显示全部楼层
感谢大佬分享,这个太实用了!

TA的精华主题

TA的得分主题

发表于 2021-1-9 12:31 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2021-4-6 10:16 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
感谢楼主分享EXCEL VBA读取多种编码的txt文件。
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-6-16 15:11 , Processed in 0.040792 second(s), 13 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表