从一个文件夹复制其中一部分文件到另一个文件夹

he383174288 · 发表于 2022-11-21 17:36

本帖最后由 he383174288 于 2022-11-21 17:36 编辑

背景：今天有某人叫我找200多项工程项目资料发给他，然后我们的文件夹内有500多项工程项目的资料，他发了一个excel表给我，需要表格中的200多项。之前买了一本VBA的书学习了一段时间，但是还是不会编写代码，这个有点复杂。
操作：我只能按照excel表里的工程名称，一个个复制，然后粘贴到另一个文件夹，操作完200多项，手都酸完，费时费力。
疑问：能不能用VBA代码，把excel表里的工程名称（文件名，文件夹），从原始文件夹复制到另一个文件夹。
上传一个假设的例子，原始文件夹内有10个项目，从项目列表里找其中的6项（最好是按表内的文件名找，表内的工程名不一定是文件夹的全名），复制到另一个文件夹呢。

高个子 · 发表于 2022-11-21 17:48

表内的工程名不一定是文件夹的全名，这又涉及模糊匹配了，能否保证是连续的呢？比如清华大学匹配清华就可以，但是北京大学匹配北大可就麻烦了。

wanghan519 · 发表于 2022-11-21 17:58

本帖最后由 wanghan519 于 2022-11-21 18:53 编辑

这种批量操作powershell真的方便：

1. 表格读入数组
2. 判断文件名按顿号分割后第二部分，是否在上面的数组里，是则复制到目标文件夹

$a=Import-Excel .\项目列表.xlsx | Select-Object -ExpandProperty 工程名称
Get-ChildItem .\原始文件夹\ | % {if(($_.Name -split '、')[1] -in $a){Copy-Item -Recurse $_.FullName .\目标文件夹\}}

复制代码

又试了试新东西，模糊匹配文件名：

Add-Type -Path D:\scripts\xlDNA\bin\Debug\Fastenshtein.dll
function fuz ($str, $arr)
{
$ret = ""
$tmp = 2
for ($i = 0; $i -lt $arr.Length; $i++)
{
$r = $arr[$i]
$t = [Fastenshtein.Levenshtein]::Distance($str, $r) / $r.Length
if ($t -lt $tmp)
{
$ret = $r
$tmp = $t
}
}
return $ret
}
$a=Get-ChildItem .\原始文件夹\ | Select-Object -ExpandProperty FullName
Import-Excel .\项目列表.xlsx | % {Copy-Item (fuz $_.工程名称 $a) .\目标文件夹\ -Recurse}

复制代码

gwjkkkkk · 发表于 2022-11-21 18:43

Sub TEST()
Dim arr, i&, strFolder$, sFolder$, dFolder$, f
Application.ScreenUpdating = False
Set fso = CreateObject("Scripting.FileSystemObject")
sFolder = ThisWorkbook.Path & "\原始文件夹"
dFolder = ThisWorkbook.Path & "\目标文件夹\"
arr = [A1].CurrentRegion
For i = 2 To UBound(arr)
      For Each f In fso.GetFolder(sFolder).SubFolders
      If f Like "*" & arr(i, 2) Then
            fso.copyfolder f, dFolder
            Exit For
      End If
      Next
Next i
Application.ScreenUpdating = True
Beep
End Sub

gwjkkkkk · 发表于 2022-11-21 18:45

代码审核中，请参考附件。。。

he383174288 · 发表于 2022-11-21 22:32

wanghan519 发表于 2022-11-21 17:58
这种批量操作powershell真的方便：

1. 表格读入数组

powershell这个太深奥了，看不懂

he383174288 · 发表于 2022-11-21 22:39

gwjkkkkk 发表于 2022-11-21 18:43
Sub TEST()
Dim arr, i&, strFolder$, sFolder$, dFolder$, f
Application.ScreenUpdating = Fal ...

太厉害了，非常实用，短短的几行代码，就实现了重复的查找、复制、粘贴等工作，省时省力。

he383174288 · 发表于 2022-11-21 22:45

gwjkkkkk 发表于 2022-11-21 18:43
Sub TEST()
Dim arr, i&, strFolder$, sFolder$, dFolder$, f
Application.ScreenUpdating = Fal ...

还有一个问题是，如果有子文件夹，可能文件夹进行了分类，然后工程名的文件夹是在子文件夹下的，需要遍历文件夹，这个怎么修改代码？

cmshun · 发表于 2022-11-22 17:38

$start = Get-Date
$path = Get-Location

$xl = new-object -comobject excel.application
$wx = $xl.workbooks.open("$path\项目列表.xlsx")
#$xl.Visible = $true
$ws = $wx.worksheets.item(1)
$row = $ws.UsedRange.Rows.Count
$arr = $ws.Range("b1:b$row").value2

for ($i = 2;$i -le $row;$i++){
$arr1 = $arr[$i,1]
$data = dir $path\old | Where-Object{$_.name -like "*$arr1*"}
Copy-Item $data.FullName $path\new -Recurse -force
Write-Host "正在复制: "$data.name"文件夹"
}
$xl.Quit()
$Wx = $NULL
$XL = $NULL
$end = Get-Date
Write-Host "用时: " (($end - $start).TotalSeconds -as [int]) "秒"
Start-Sleep -Seconds 1
[GC]::Collect()
powershell方法，windows10以上可用，右键使用powershell运行

gwjkkkkk · 发表于 2022-11-22 18:41

摸拟了一下，请楼主参考。。。

		自动登录	找回密码
密码			免费注册

[求助] 从一个文件夹复制其中一部分文件到另一个文件夹

评分