首页 > 解决方案 > 是否可以使用 VBA 一次使用 (*.txt) 移动(一个文件夹到另一个文件夹)一个文本文件

问题描述

我已经编译了一些数据,我想使用 (*.txt) 一次将一个文本文件移动到另一个文件夹。可能吗?

我只想要 (*.txt) 的那个函数,因为使用任何其他函数对我来说很复杂,并且最适合我的代码。

我想要做的是将 Move.File 函数循环到 7 个文本文件,其中一个文件只移动一次,然后下一个文件移动,依此类推。在移动一个文本文件时,另一个命名函数提取下一个文本名称。希望这是有道理的。

Dim FSO As Object
Dim SourceFileName As String, DestinFileName As String

k = 0
Do While k < 19
ActiveCell.Offset(-2, k).MergeArea.ClearContents
ActiveCell.Offset(-2, k).Value = Dir(FolderName & "*.txt*")
Set FSO = CreateObject("Scripting.Filesystemobject")
SourceFileName = "Y:\Engineering\*.txt"
DestinFileName = "Y:\Engineering\Completed\"
FSO.MoveFile Source:=SourceFileName, Destination:=DestinFileName
k = k + 3
Loop

Dim sht As Worksheet
Dim fnd As Variant
Dim rplc As Variant
fnd = ".txt"
rplc = ""
For Each sht In ActiveWorkbook.Worksheets
sht.Cells.Replace what:=fnd, replacement:=rplc
Next sht

End Sub

当我使用此代码时,它会立即将所有文本文件移动到该文件夹​​中。因此,当我循环将标题命名为文本文件时,它会出错。

标签: excelvba

解决方案


如果我正确理解了您的目标,那么可以尝试(根据我对目标的理解测试成功执行)

Sub test()
Dim FSO As Object
Dim SourceFileName As String, DestinFileName As String
Dim FolderName As String
FolderName = "Y:\Engineering\"
FolderName = "C:\users\user\Desktop\Folder1\"    'modify to your requirement

Set FSO = CreateObject("Scripting.Filesystemobject")

k = 0
SourceFileName = Dir(FolderName & "*.txt")
    Do While k < 19 And SourceFileName <> ""
    Debug.Print SourceFileName
    ActiveCell.Offset(-2, k).MergeArea.ClearContents
    ActiveCell.Offset(-2, k).Value = SourceFileName
    DestinFileName = FolderName & "Completed\" & SourceFileName
    SourceFileName = FolderName & SourceFileName
    FSO.MoveFile Source:=SourceFileName, Destination:=DestinFileName
    k = k + 3   ' Why K is being incremented by 3? It will only move seven files  
    SourceFileName = Dir
    Loop

Dim sht As Worksheet
Dim fnd As Variant
Dim rplc As Variant
fnd = ".txt"
rplc = ""
For Each sht In ActiveWorkbook.Worksheets
sht.Cells.Replace what:=fnd, replacement:=rplc
Next sht
End Sub

推荐阅读