一段代码优化。
Server_Date = CStr(Format(Sqlser_time, "yyyy-mm-dd hh:mm:ss"))
adv_CustomName = Trim(frmMain!lblInfo(0))
' Dim i As Integer
Dim LocalFolder As String
Dim DefaultFolder As String
DefaultFolder = "D:\ADVPRO"
LocalFolder = DefaultFolder & Format(Server_Date, "yyyy.mm.dd") & "" & CStr(Trim(adv_CustomName)) & "" & ""
PhotoPath = Trim(LocalFolder) '照片存储路径
frmMain.txtLocalPath = Trim(LocalFolder)
Set FSO = CreateObject("scripting.filesystemobject") '设置对象s
If FSO.FolderExists(LocalFolder) = True Then Call DelMyFolder(LocalFolder) '如果存在文件夹,则删除
If FSO.FolderExists(DefaultFolder) = True Then Call DelMyFolder(DefaultFolder) '如果存在文件夹,则删除
Call AutoCreateFolder(Trim(LocalFolder)) '创建选片顾客文件夹
ctMeter.Value = 0
ctMeter.Visible = True
ctMeter.Caption = "正在准备读取文件,请稍候..."
ctListPhoto.ClearList '清除LIST内容。
Set objFolder = FSO.GetFolder(FolderView.SelectedFolder)
Set objFile = objFolder.Files
'列取从本地或局域网中顾客照片的文件路径中的文件
For Each objFile In objFile
ctListPhoto.AddItem CStr(objFolder) & "" & objFile.name + Chr(10) + objFile.name
Next
If ctListPhoto.ListCount < 1 Then MsgBox "选择的项目没有文件,请联系管理员!", vbOKOnly + vbExclamation, "提示": Exit Sub
'如果系统设置自动打乱顺序则执行
If PhotoRandom = True Then
Call Randomize_ctList(ctListPhoto, 2)
For i = 0 To ctListPhoto.ListCount - 1
ctListPhoto.CellText(i, 1) = CStr(objFolder) & "" & ctListPhoto.CellText(i, 2)
Next
End If
frmMain!ctMeter.Caption = "数据缓冲,请稍候..."
frmMain!ctMeter.Value = 0
frmMain!ctMeter.Visible = True
Me.Hide
frmMain!Thumbnail.DeleteItems
frmMain!lstShow.ClearList
frmMain!lstShowMore.ClearList
' 先下载5个照片预载到缩略图中
If ctListPhoto.ListCount > 5 Then
For i = 0 To 4
DoEvents
If Right(LocalFolder, 1) = "" Then LocalFolder = LocalFolder Else LocalFolder = LocalFolder & ""
FSO.CopyFile ctListPhoto.CellText(i, 1), Replace(Replace(LocalFolder, "||", "\") & "", "\", "") & ctListPhoto.CellText(i, 2), True
'添加到lstShow列表中。
frmMain!lstShow.AddItem LocalFolder & ctListPhoto.CellText(i, 2)
' Call Thumb_ShowList(CStr(LocalFolder & ctListPhoto.CellText(i, 2)))
If i > 0 Then frmMain!ctMeter.Value = i / (ctListPhoto.ListCount - 6) * 100
Next
End If
For i = 0 To frmMain!lstShow.ListCount - 1
frmMain!Thumbnail.AddFileItems frmMain!lstShow.CellText(i, 1), frmMain!Thumbnail.ItemCount, True
Next
' 添加剩余的照片到缩略图中
For i = 5 To ctListPhoto.ListCount - 1
DoEvents
If Right(LocalFolder, 1) = "" Then LocalFolder = LocalFolder Else LocalFolder = LocalFolder & ""
FSO.CopyFile ctListPhoto.CellText(i, 1), Replace(Replace(LocalFolder, "||", "\") & "", "\", "") & ctListPhoto.CellText(i, 2), True
'添加到lstShowMore列表中。
frmMain!lstShow.AddItem LocalFolder & ctListPhoto.CellText(i, 2)
frmMain!lstShowMore.AddItem LocalFolder & ctListPhoto.CellText(i, 2)
' frmMain!Thumbnail.AddFileItems CStr(LocalFolder & ctListPhoto.CellText(i, 2)), frmMain!Thumbnail.ItemCount, True
If i > 0 Then frmMain!ctMeter.Value = i / (ctListPhoto.ListCount - 1) * 100
Next
frmMain!ctMeter.Visible = False
Set FSO = Nothing
DoEvents
For i = 5 To frmMain!lstShow.ListCount - 1
frmMain!Thumbnail.AddFileItems frmMain!lstShow.CellText(i, 1), frmMain!Thumbnail.ItemCount, True
Next
frmMain!lblPhotoCount = "TCO:" & frmMain!Thumbnail.ItemCount