Private Sub cmdImg_Add_Click()
On Error GoTo err_cmdImg_Add_Click
Dim strDialogTitle As String
Dim PathStrg As String
Dim relativePath As String
Dim dbPath As String
Dim msg As String
Dim SResult As String 'ADDED for image size restriction
Dim LResult As Long 'ADDED for image size restriction
Dim retVal As Variant 'ADDED for image size restriction
If Not IsNull(txtSetUpStepID) Then
'strDialogTitle = "Select an image
PathStrg = GetOpenFile_CLT(".\", strDialogTitle)
'If no file was selected then the PathStrg variable will be empty.
'If there was a file selected then.....
If PathStrg <> "" Then
'**********************************************************START IMAGE SIZE RESTRICTION*************
'http://www.techonthenet.com/access/functions/file/filelen.php
LResult = FileLen(PathStrg)
SResult = Format(LResult / 100000, "#0.00") & " kb" '100000 Byte = 100 Kilobyte (kb)
'MsgBox LResult
'MsgBox SResult
'If the image is larger than 100kb then or 100000 bytes
If LResult > "100000" Then
MsgBox "Your Image you selected is " & SResult & " which exceeds the size limit of 100kb max." & vbCrLf & _
"When you close this prompt your image will open in Microsoft Paint so you can resize it.", vbCritical, "Image To Large"
'Open Microsoft Paint with oversized image
retVal = Shell("c:\windows\system32\mspaint.exe " & Chr$(34) & PathStrg & Chr$(34), vbMaximizedFocus)
'Exit out of sub
Exit Sub
'Else If the image is less than 100kb then or 100000 bytes then allow the image and continue
ElseIf LResult < "100000" Then
'**********************************************************END IMAGE SIZE RESTRICTION***************
'setup new file name and appropriate DB subfolder
relativePath = "\SetUp_Images\" & Me.txtSetUpStepID & ".jpg"
'Finds BE path in module-modGetPath
dbPath = GetCurrentPath()
'copy selected file with new name and subfolder
FileCopy LCase(PathStrg), dbPath & relativePath
'update the table field with the new file name and relative location
Me!ImagePath.Value = relativePath
'**********************************************************REQUERY AND STAY ON RECORD START****************
'display the image from the subfolder of the DB
'Me.Requery
Dim RecUF As Long
RecUF = Me!SetUpStepID
Me.Requery
Me.Recordset.FindFirst "[SetUpStepID] = " & RecUF
'**********************************************************REQUERY AND STAY ON RECORD END******************
End If
End If 'ADDED for image size restriction
Else
'If no ID number in (txtSetUpStepID) then display message box
MsgBox "You must enter a SetUp step before adding an image.", vbExclamation, "Enter A SetUp Step"
exit_cmdImg_Add_Click:
Exit Sub
err_cmdImg_Add_Click:
Select Case Err.Number
Case 70
msg = "You are already using this image already for another step"
MsgBox msg, vbOKOnly + vbInformation, "Image already in use!", Err.HelpFile, Err.HelpContext
Case 76
msg = "The image folder is not with this database or its been renamed!"
MsgBox msg, vbOKOnly + vbInformation, "Image folder not found!", Err.HelpFile, Err.HelpContext
Case Else
msg = "Error # " & Str(Err.Number) & Chr(13) & Err.Description
MsgBox msg, vbOKOnly, "Add/Change Image Button Error", Err.HelpFile, Err.HelpContext
End Select
Resume exit_cmdImg_Add_Click
End If
End Sub