Private Sub CommandButton5_Click()Name "D:\kzzx\(时间命文件).txt" As _"D:\kzzx\123.txt"End Sub因每次下载的TXT文件名不一样,这个文件夹只有这个文件,怎么来复制这个唯一的文件,怎么来用*代替
或者查找D:\KZZX\****.TXT文件并更名,这样怎么编
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
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文件,代码会进行相应的提示。