我尝试编写一个脚本,根据文件名将文件从一个文件夹复制到另一个文件夹(类似)。因为我在文件夹中获得了数千个文本文件。但我尝试在数千个文件中找到数百个文件。这需要花费大量时间逐一搜索。
Copy
似乎是个好主意,然后用它来遍历我试图找到的数千个文件列表。但Copy
需要指定的名称。问题是我只有部分文件名。
文件列表示例(文本文件的内容):
ABCDEF-A01
ADEWSD-B03
ABDDER-C23
文件名示例:
GGI_1409506_ABCDEF-A01.txt
,GGI_ADEWSD-B03.txt
,DA_ABDDER-C23_12304.txt
我只获得了ABCDEF-A01
而不是完整的文件名。
预期结果:
能够搜索文件夹并将文件复制到根据文件列表匹配的另一个位置(一个文本文件)。
你能分享的任何东西?信息/ ans /相关帖子?非常感谢你!
答案 0 :(得分:1)
在perl中尝试以下代码。运行程序时,会传递源目录路径和目标目录路径的参数以及需要搜索的文件名列表。如果目标目录不存在,它将自动通过程序创建一个文件夹,如下所示:
代码:
use strict;
use warnings;
use File::Copy;
my $source = $ARGV[0];
my $destination = $ARGV[1];
my $listFiles = $ARGV[2];
if(-f $destination)
{
print "Already unknown extension of file exists with the same name of directory. So rename the file and run the program";
exit 0;
}
if(-d "$destination")
{
print "Directory where files need to be copied: $destination\n";
}
else
{
print "No Directory found and hence created the directory $destination\n";
mkdir("$destination");
}
opendir DIR, $source or die "cant open dir";
my @files = grep /(.*?)(\.txt)$/,(readdir DIR);
open my $fh, '<', "$listFiles" or die "Cannot open the file names to search $listFiles - $!";
open my $out,'>', "$ARGV[1]\\NoMatch.txt" or die "Cannot write to the file NoMatch.txt - $!";
my @listFileNames = <$fh>;
my @listFiles = ();
foreach my $InputFiles (@files)
{
chomp($InputFiles);
foreach my $list(@listFileNames)
{
chomp($list);
if($InputFiles =~ /$list/isg)
{
print "Files : $InputFiles copying\t";
copy("$InputFiles","$destination");
print "Files : $InputFiles copied\n";
push(@listFiles,$list);
}
}
}
my %seen = ();
my $count = 0;
foreach my $list (@listFiles)
{
$seen{lc($list)} = 1;
#print $list . "\n";
}
foreach my $listnames (@listFileNames)
{
if($seen{lc($listnames)})
{
}
else
{
if($count ==0)
{
print "\nFilenames that did not match the text files are present in the destination folder : NoMatch.txt file " . "\n";
}
print $out "$listnames\n";
$count++;
}
}
close($out);
close($fh);
closedir(DIR);
答案 1 :(得分:0)
创建批处理文件并将其放在源文件夹中,并附上要复制的文件列表。
for /f %%f in (list.txt) do robocopy c:\source d:\dest %%f
答案 2 :(得分:0)
希望这有帮助
#!/usr/bin/perl -w
use strict;
use File::Copy;
my $sorce_direcrtory = qq{};
my $new_directory = "";
opendir(my $dh, $sorce_direcrtory) || die;
while(readdir $dh) {
if($_ =~ /[A..Z]+\-[A..Z]\d+/){
move("$sorce_direcrtory/$_", "$new_directory/$_");
}
}
closedir $dh;