求助批处理从压缩文件提取图片放到Excel里面

司马光2008

求助各位大神，我有很多的压缩文件，几万个，里面有很多图片，什么能把压缩文件里面的图片提取出来放到Excel里面

样本：
ABC.ZIP文件   ，CDE.ZIP文件。。。。   提取里面固定名称的图片，放置到EXCEL的同一列里面

转换后的EXCEL格式样子，

ABC    图片
CDE    图片
。
。
。

Batcher

回复 1# 司马光2008


    请把样本上传到网盘我试试

司马光2008

放到百度网盘中，链接：https://pan.baidu.com/s/1CBjXR_MYJ9494K3wWtMMZA
提取码：4p0v

czjt1234

图片大小怎么处理？

司马光2008

压缩到EXCEL一个格中，只要图片不失真就行

523066680

丢给AI写

czjt1234

vbs

1. Option Explicit
   
2. Dim oFSO, oWshShell, oShell, oExcel, oWorksheet, temp, s, n, i
   
3. 
   
4. Const zipFolder = "."             '当前路径，可自定义
   
5. Const jpgFile   = "西红柿.jpg"
   
6. Const ExcelFile = "1.xlsx"        '要求文件已存在
   
7. Const Width     = 30              '图片的宽
   
8. Const Height    = 30              '图片的高
   
9. 
   
10. Set oFSO      = CreateObject("Scripting.FileSystemObject")
    
11. Set oWshShell = CreateObject("WScript.Shell")
    
12. Set oShell    = CreateObject("Shell.Application")
    
13. Set oExcel    = CreateObject("Excel.Application")
    
14. 
    
15. s = oFSO.GetParentFolderName(WScript.ScriptFullname)
    
16. oWshShell.CurrentDirectory = s
    
17. i = oFSO.GetAbsolutePathName(zipFolder)
    
18. s = oFSO.GetAbsolutePathName(ExcelFile)
    
19. Set oWorksheet = oExcel.Workbooks.Open(s).Sheets(1)
    
20. oWorksheet.Columns("B").ColumnWidth = Width
    
21. s = oWshShell.ExpandEnvironmentStrings("%temp%")
    
22. oWshShell.CurrentDirectory = s
    
23. temp = s & oFSO.GetTempName()
    
24. s = ""
    
25. Call EnumZIP(i)
    
26. n = 1
    
27. For Each i In Split(Left(s, Len(s) - 2), vbCrLf)
    
28.     oFSO.CreateFolder temp
    
29.     oShell.NameSpace(temp).CopyHere oShell.NameSpace(i).Items
    
30.     s = ""
    
31.     Call EnumJPG(temp)
    
32.     If s <> "" Then Call toExcel(s, oFSO.GetBaseName(i))
    
33.     oFSO.DeleteFolder temp
    
34. Next
    
35. oExcel.Visible = True
    
36. 
    
37. Sub toExcel(ByVal jpg, ByVal i)
    
38.     Dim oPicture
    
39.     oWorksheet.Rows(n).RowHeight = Height
    
40.     Set oPicture = oWorksheet.Pictures.Insert(jpg)
    
41.     oPicture.Top = oWorksheet.Range("B" & n).Top
    
42.     oPicture.Left = oWorksheet.Range("B" & n).Left
    
43.     oPicture.Width = Width
    
44.     oPicture.Height = Height
    
45.     oWorksheet.Range("A" & n) = i
    
46.     n = n + 1
    
47. End Sub
    
48. 
    
49. Sub EnumZIP(ByVal folderPath)
    
50.     Dim oFile, oFolder
    
51.     On Error Resume Next
    
52.     For Each oFile In oFSO.GetFolder(folderPath).Files
    
53.         If LCase(oFSO.GetExtensionName(oFile.Path)) = "zip" Then
    
54.             s = s & oFile.Path & vbCrLf
    
55.         End If
    
56.     Next
    
57.     For Each oFolder In oFSO.GetFolder(folderPath).SubFolders
    
58.         Call EnumZIP(oFolder.Path)
    
59.     Next
    
60. End Sub
    
61. 
    
62. Sub EnumJPG(ByVal folderPath)
    
63.     Dim oFile, oFolder
    
64.     For Each oFile In oFSO.GetFolder(folderPath).Files
    
65.         If LCase(oFile.Name) = LCase(jpgFile) Then
    
66.             s = oFile.Path
    
67.         End If
    
68.     Next
    
69.     For Each oFolder In oFSO.GetFolder(folderPath).SubFolders
    
70.         Call EnumJPG(oFolder.Path)
    
71.     Next
    
72. End Sub

复制代码

只支持 .zip 文件，如果有 .rar 文件需要改用 winrar.exe 或 7z.exe 解压