用VBA复制文本内容到Excel工作表中？

Question

Private Sub CommandButton5_Click()Name "D:\kzzx\（时间命文件）.txt" As _"D:\kzzx\123.txt"End Sub因每次下载的TXT文件名不一样，这个文件夹只有这个文件，怎么来复制这个唯一的文件，怎么来用*代替
或者查找D:\KZZX\****.TXT文件并更名，这样怎么编

Answer 1

Sub 提取txt数据()

'**********************************************************************

Dim iPt As String

iPt = "E:\文档\桌面\测试" '请用户在此行指定txt的所在目录

'**********************************************************************

If Not iPt Like "*\" Then iPt = iPt & "\" '修正路径确保是反斜杠结尾

'退出机制

Dim str As String

str = Dir(iPt) '获取目录中首个文件名称

If str = "" Then

MsgBox "此目录中没有文件！"

Exit Sub '退出sub

End If

If Not str Like "?*.txt" Then

MsgBox "此目录首个文件不是txt格式！"

Exit Sub '退出sub

End If

'读取txt数据写入数组中

iPt = iPt & str '连接出txt文件的完整路径

Dim ar() As Variant, k As Integer

str = "" '重置为空

Open iPt For Input As #1 '打开iPt文档编号1号

Do Until EOF(1) '当指针越界时结束循环

Line Input #1, str '按行读取到变量中

k = k + 1 '累加

ReDim Preserve ar(1 To 1, 1 To k) As Variant '扩展数组

ar(1, k) = str '写入到数组中

Loop

Close #1 '关闭1号文件

Kill iPt '杀列iPt文件(彻底删除,非放入回收站)

'将数组的数据写入到工作表中

With Sheet1

.Range("A1") = "文件路径：" & iPt '标题：A1输出文件路径

.Range("A2") = "提取时间：" & Format(Now, "yyyy-m-d h:mm:ss") '标题：A2输出提取时间

.Range("A3").Resize(k) = WorksheetFunction.Transpose(ar) '在A3输出数组ar转置后的数据

End With

'结束时弹出提示对话框

MsgBox "处理完毕！", 64

End Sub

Answer 2

你可以使用VBA来实现在指定文件夹中查找和复制唯一的TXT文件。
Private Sub CommandButton5_Click()
Dim sourceFolderPath As String
Dim destinationFilePath As String
Dim fileName As String
Dim fileExtension As String
Dim filesInFolder As Variant
Dim foundFile As String
' 设置源文件夹路径
sourceFolderPath = "D:\kzzx\"
' 设置目标Excel工作表中的位置
destinationFilePath = ThisWorkbook.Path & "\output.xlsx" ' 请根据实际情况修改目标文件路径
' 获取源文件夹中的所有文件
filesInFolder = Dir(sourceFolderPath & "*.txt")

' 初始化找到的文件名
foundFile = ""
' 遍历文件夹中的所有文件
Do While filesInFolder <> ""
' 排除文件夹和非TXT文件
If Not (Left(filesInFolder, 1) = ".") And Right(filesInFolder, 4) = ".txt" Then
' 找到唯一的TXT文件
If foundFile = "" Then
foundFile = filesInFolder
Else
MsgBox "找到多个TXT文件，请确保文件夹中只有一个TXT文件。"
Exit Sub
End If
End If
filesInFolder = Dir
Loop

' 检查是否找到了TXT文件
If foundFile = "" Then
MsgBox "未找到TXT文件。"
Exit Sub
End If
' 将找到的TXT文件复制到Excel工作表中
Workbooks.OpenText FileName:=sourceFolderPath & foundFile, DataType:=xlDelimited, Tab:=False
ActiveSheet.Copy Before:=ThisWorkbook.Sheets(1)
ActiveSheet.Name = "CopiedTXT"
ActiveWorkbook.Close SaveChanges:=False

' 清理剪贴板
Application.CutCopyMode = False
End Sub
```
你需要将`destinationFilePath`设置为目标Excel工作表的路径，以及根据需要修改目标工作表的名称。此代码将在给定的文件夹中查找唯一的TXT文件，并将其复制到新的工作表中。请注意，如果文件夹中有多个TXT文件或者没有TXT文件，代码会进行相应的提示。