Hi Hans.
Here's the full unload event which is made up from a couple of routines I put together.
Perhaps there's something in there untowards which needs attention.
There's a good article I've just been looking at which may be useful to other users:
http://www.pcnetcom.net/visual_b.htm
So my queryUnload should look like ?
Code: Select all
Set fso = Nothing
Form1024Image.Show
SetDirtyFalse
Unload Me
Full Unload:
Code: Select all
Private Sub Form_Unload(Cancel As Integer)
Dim JN As String 'Job Number
Dim fn As String 'FileName
Dim AN As String 'Archive Name
Dim DP As String 'Default Path
Dim AP As String 'Archive Path
Dim intMax As Integer 'Maximum File No
Dim intPos As Integer
Dim pos1 As Integer, pos2 As Integer 'Position ??
Dim intPos2 As Integer
Dim intSeq As Integer 'Sequence
Dim FF As String 'Final File
Dim strFolderName As String
Dim fso As FileSystemObject
Dim fName As String
Dim FileName As String
Dim IP As ImageProcess
Dim img As ImageFile
Dim x As Integer
Dim txtJob As String
If Dirty = True Then
x = MsgBox("The image has been changed." & vbCrLf & vbCrLf & "Do you wish to save the changes?", vbExclamation + vbYesNo, "The image has been changed")
If x = 6 Then
'Check if list contains any selections
On Error Resume Next
txtJob = frmMain.txtJob.Text
' Get position of -
pos1 = InStrRev(txtJob, "-")
' Get position of \
pos2 = InStrRev(txtJob, "\", pos1 - 1)
' Extract part between \ and -
fName = Mid(txtJob, pos2 + 1, pos1 - pos2 - 1)
JN = fName
'Ensure Job No is entered
If IsNumeric(JN) Then 'Check If Estimate Number or Registration
intMax = 0
DP = "L:\MMPDF\ConsoleFiles\" & JN & "\"
AP = "L:\MMPDF\Archive\" & JN & "\"
fn = Dir(DP & JN & "-*.jpg")
strFolderName = "L:\MMPDF\ConsoleFiles\" & JN & "\"
If Dir(strFolderName, vbDirectory) = "" Then
MkDir strFolderName
End If
Do Until fn = ""
intPos = InStrRev(fn, ".")
intPos2 = InStrRev(fn, "-", intPos - 1)
intSeq = Val(Mid(fn, intPos2 + 1, intPos - intPos2 - 1))
If intSeq > intMax Then
intMax = intSeq
End If
fn = Dir
Loop
AN = Dir(AP & JN & "-*.jpg")
Do Until AN = ""
intPos = InStrRev(AN, ".")
intPos2 = InStrRev(AN, "-", intPos - 1)
intSeq = Val(Mid(AN, intPos2 + 1, intPos - intPos2 - 1))
If intSeq > intMax Then
intMax = intSeq
End If
AN = Dir
Loop
Set img = CreateObject("WIA.ImageFile")
Set IP = CreateObject("WIA.ImageProcess")
intMax = intMax + 1
If intMax = 999 Then MsgBox "You Have Exceeded The Amount Of Images" & vbCrLf & _
"That Can Be Saved For This File" & vbCrLf & _
"You Must Report This To Dave Willett", vbCritical, "Error": Exit Sub
FF = JN & "-" & Format(intMax, "000") & ".jpg"
FileName = frmMain.ActiveForm.Buffer.Image
SavePicture frmMain.ActiveForm.Buffer.Image, DP & FF
ImgConvert DP & FF, DP & FF, True
frmMain.ActiveForm.SetDirtyFalse
End If
Set fso = Nothing
Form1024Image.Show
SetDirtyFalse
Else
'FileName = GetSaveName("Save As...")
'If FileName <> "" Then
' SavePicture frmMain.ActiveForm.Buffer.Image, FileName
' frmMain.ActiveForm.Buffer.Tag = FileName
' frmMain.ActiveForm.Caption = FileName & " - " & frmMain.ActiveForm.GetZoomFactor & "%"
' SetDirtyFalse
'Else
' x = MsgBox("Save failed." & vbCrLf & vbCrLf & "Close anyway?", vbCritical + vbYesNo, "Save failed.")
If x <> 6 Then Cancel = True
End If
'Unload Me
Set fso = Nothing
Form1024Image.Show
SetDirtyFalse
Unload Me
End If
End Sub
Cheers ...
Dave.
