vb 文件夹里图片打包

Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Sub Form_Load()
Dim Path As String, fn As String, c As Long, n As Long
Dim WinRarFilePath As String
WinRarFilePath = "c:\program files\winrar\winrar.exe" '例如"c:\program files\winrar\winrar.exe"
Path = '例如"d:\图片文件夹"
c = 100
fn = Dir(Path & "\*.jpg", vbHidden + vbReadOnly + vbSystem) '如果文件夹里只有图片文件，可以用*代替*.jpg，*.jpg只压缩JPG图片
Do While Len(fn)
If fn = "." Or fn = ".." Then GoTo nt
c = c + 1
If c > 100 Then c = 1: n = n + 1: MkDir Path & "\" & n
Name Path & "\" & fn As Path & "\" & n & "\