[已解决]大侠帮忙，谢谢

jianjian053

目的：通过人员名单中的合同号将此合同号在四个文件夹中的照片提取到一个用合同号命名或者新建文件夹中，谢谢了！

最佳答案

月排行榜 / 总排行榜

dsmch

2015-3-5 19:54

………………

跳转到最佳答案楼层

dsmch

手工模拟一下结果，方便理解问题

jianjian053

dsmch 发表于 2015-3-5 15:46
手工模拟一下结果，方便理解问题

压缩包里有五个文件夹，有四个有图片，分别是H2S\HSE\井控证、司钻证、这四个文件夹里是全部人员的照片，都是以合同号命名的！！！！人员名单中的合同号是四个文件夹里都存在的，我想在表格中输入合同号码，然后就从四个文件夹中提取这个合同号命名的照片到“查找人员”这个文件夹里（也可以自动生成一个文件夹），新的压缩包里带了一个表格，但是只能提取一个文件夹的，而且复制过去的照片合同号前面的0没了，麻烦您了

jianjian053

dsmch 发表于 2015-3-5 15:46
手工模拟一下结果，方便理解问题

还在吗？麻烦您了

dsmch

1. Sub Macro1()
   
2. Dim fs, w, mypath$$, i&, j%, wj$$, wj2$$
   
3. Set fs = CreateObject("scripting.filesystemobject")
   
4. mypath = ThisWorkbook.Path & ""
   
5. w = Array("H2S证", "HSE证", "井控证", "司钻证")
   
6. For i = 2 To Range("a65536").End(xlUp).Row
   
7.     For j = 0 To UBound(w)
   
8.         wj = mypath & w(j) & "" & Cells(i, 1) & ".jpg"
   
9.         wj2 = mypath & "查找人员" & "" & Cells(i, 1) & j + 1 & ".jpg"
   
10.         If fs.FileExists(wj) Then fs.CopyFile wj, wj2
    
11.     Next
    
12. Next
    
13. MsgBox "OK"
    
14. End Sub

复制代码

dsmch

………………

jianjian053

dsmch 发表于 2015-3-5 19:54
………………

你好，老师，请问你对word里的邮件合并熟悉吗？我邮件合并的照片无法固定显示大小，有办法吗？附件超过500K了  不让上传