如何通过GetOpenFilename将多个TXT文件复制粘贴到一张sheet中

Gaudi34

各位师傅好，我想通过GetOpenFilename选择多个TXT文件，然后导入在一张sheet中，但是通过open好像没有办法打开变量路径，不知道代码是哪里有问题。第二个问题是别的系统导出的TXT文件，TXT转码有点问题，无法通过StrConv进行转换，而且TXT文件里没有回车键，是黑色方形。在现有TXT文件无法改变的情况下（请不要更改TXT文件内容），如何通过VB转换TXT文件，然后复制粘贴到EXCEL中呢？谢谢各位师傅了。

Gaudi34

是不是比较复杂麻烦？

shenjianrong163

你这个是UTF-8格式的文件，简单提取了下，不知道你最终要实现的表格数据效果，根据结果再用数组处理一次就行。

1. Sub test()
   
2.     Dim i%, j%, s, st, arrByte() As Byte, arr()
   
3.     Application.ScreenUpdating = False
   
4.     Filename = ThisWorkbook.Path & "" & Dir(ThisWorkbook.Path & "" & "*.txt") '获取当前目录下的txt文件
   
5.     If Len(Dir(ThisWorkbook.Path & "" & "*.txt")) Then   '判断是否存在txt文件
   
6.         Open Filename For Binary Access Read As #1
   
7.         ReDim arrByte(LOF(1) - 1)
   
8.         Get #1, , arrByte
   
9.         Close #1
   
10.         s = Split(ByteToStr(arrByte, "UTF-8"), Chr(10)) '调用ByteToStr函数,s获取UTF-8或Unicode编码的内容
    
11.     Else
    
12.         MsgBox "当前目录下没有txt文件!": Exit Sub '当前目录下没有txt文件,退出程序
    
13.     End If
    
14.     If UBound(s) < 0 Then MsgBox "txt文件中没有数据!": Exit Sub  'txt文件中没有内容,退出程序
    
15.     ReDim arr(1 To UBound(s) + 1, 1 To 100) '预设100列
    
16.     For i = 0 To UBound(s)
    
17.         st = Split(s(i), ",") '以逗号将数组s的内容分割开
    
18.         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的列数
    
19.         For j = 0 To UBound(st)
    
20.             arr(i + 1, j + 1) = st(j)
    
21.         Next
    
22.     Next
    
23.     With Sheets("原始数据")
    
24.         .UsedRange.ClearContents
    
25.         .[A1].Resize(UBound(arr), UBound(arr, 2)) = arr
    
26.     End With
    
27.     Application.ScreenUpdating = True
    
28.     MsgBox "txt文件读取完成!", "64", "温馨提示"
    
29. End Sub
    
30. Function ByteToStr(arrByte, strCharset As String) As String 'ByteToStr函数读取UTF-8或Unicode编码的内容
    
31.     With CreateObject("Adodb.Stream")
    
32.         .Type = 1
    
33.         .Open
    
34.         .Write arrByte
    
35.         .Position = 0
    
36.         .Type = 2
    
37.         .Charset = strCharset
    
38.         ByteToStr = .Readtext
    
39.         .Close
    
40.     End With
    
41. End Function

复制代码

shenjianrong163

不知道你最终的数据效果，简单提取了一下，请参考附件：



用VB导入TXT文件.rar (17.57 KB, 下载次数: 7)

2020-7-5 09:36 上传

点击文件名下载附件

老骥705664849

Sub shishi()
Dim i%
Dim str()
Set sh = ThisWorkbook.Worksheets("原始数据")
str = Application.GetOpenFilename("TXT数据文件,*.txt", , , , True)
For i = 1 To UBound(str)
    Set wb = Workbooks.Open(str(i))
    ar = wb.Worksheets(1).UsedRange
    r = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1
    If r = 2 Then
        r = 1
    Else
        r = r
    End If
    sh.Cells(r, 1).Resize(UBound(ar), UBound(ar, 2)) = ar
    wb.Close False
Next i
End Sub

老骥705664849

用VB导入TXT文件.rar (16.88 KB, 下载次数: 7)

2020-7-5 10:19 上传

点击文件名下载附件

老骥705664849

直接把txt文件当excel文件打开，拷贝数据即可

Gaudi34

shenjianrong163 发表于 2020-7-5 09:37
不知道你最终的数据效果，简单提取了一下，请参考附件：

哇，师傅的代码好高大上，我要好好学习下。我想通过GetOpenFilename，让使用者有个交互的过程，可以直接选择文件。我又在网上找了找解决方案，现在问题解决了，非常感谢您。

Gaudi34

老骥705664849 发表于 2020-7-5 10:19

您的方法非常适合我，有一些代码我还不懂，我会好好学习的，不过效果是达到了，高兴。