1、代码目的
将一个大文件夹中，多个文件夹中的照片尺寸，由900*675调整为291*218；
以下照片为调整结果：
此主题相关图片如下：qq截图20200930223050.png
此主题相关图片如下：qq截图20200930223022.png
2、错误提示
运行的过程中时不时的会出现以下问题，并且每次出现错误的地方不同，貌似是随机的，但也有少数情况会全部完成；
比如;大文件夹中有10个文件夹，运行的时候出错的位置可能在第4个或者第6个文件夹，不固定，但有时候会全部转换完成，出错原因应该与照片没啥关系。
此主题相关图片如下：qq截图20200930220049.png
3、具体代码
'选择文件夹
Dim dlg As New FolderBrowserDialog
If dlg.ShowDialog = DialogResult.Ok Then
'MessageBox.Show("你选择的目录是:" & dlg.SelectedPath,"提示")
End If
Dim Names As New List(Of String)
For Each dir As String In FileSys.GetDirectories(dlg.SelectedPath)
Names.Add( dir)
Next
'调整照片大小 保存在缩略图文件夹中
If Names.Count > 0 Then
'多个文件夹操作
For Each dir As String In FileSys.GetDirectories(dlg.SelectedPath) 'dir桥文件名路径,子目录
'///压缩照片
For Each File As String In FileSys.GetFiles(dir) 'file照片路径
'///新建文件夹
If FileSys.DirectoryExists(dir & "\缩略图\" ) Then '如果目录C:\MyFolder存在
Else
FileSys.CreateDirectory(dir & "\缩略图\" )
End If
'////
Dim img As image = getImage(File)
If img.width > 700 Then
Dim bmp As new bitmap(img, 290.97,217.87 )
bmp.save(dir & "\缩略图\" & filesys.GetName(File))
bmp.Dispose
End If
'////
Next
Next
Else
'单个文件夹操作
For Each File As String In FileSys.GetFiles(dlg.SelectedPath) 'file照片路径
'///新建文件夹
If FileSys.DirectoryExists(dlg.SelectedPath & "\缩略图\" ) Then '如果目录C:\MyFolder存在
Else
FileSys.CreateDirectory(dlg.SelectedPath & "\缩略图\" )
End If
'////
Dim img As image = getImage(File)
If img.width > 700 Then
Dim bmp As new bitmap(img, 290.97,217.87 )
bmp.save(dlg.SelectedPath & "\缩略图\" & filesys.GetName(File))
bmp.Dispose
End If
'////
Next
End If
MessageBox.Show("完成","提示")
[此贴子已经被作者于2020/10/5 9:46:04编辑过]
加好友 
发短信
Post By：2020/9/30 22:41:00 [只看该作者]
