The routine takes selected images and renames them with the job number ( JN ) and the next available sequence ( intMax -?? ).
The last couple of days I have had to update the software to accommodate the change in our job numbers from 5 digits to 6 ( and More ) digits, done successfully I add.
My software when running will import 99 images per job number, which I thought for many years would be ample !
Requests from our work providers for more images per job is becoming more frequent now and when my staff import over 99 ( which I have restricted ) sometimes images are over written. So, for future proof, I need to change the import routine to accommodate more than 99.
Below is the code which renames the files and determines the sequence to use. I could do with a little help in changing this to complete my update.
It seems that "intMax" is where the change needs to be done ( from -?? to -??? ) but I really don't want to mess with the code given my limited experience.
Help would be appreciated.
Code: Select all
Private Sub cmdExport_Click()
Dim JN As String 'Job Number
Dim DF As String 'Default Folder
Dim fn As String 'FileName
Dim AN As String 'Archive Name
Dim N As Integer 'Number
Dim DP As String 'Default Path
Dim AP As String 'Archive Path
Dim intMax As Integer 'Maximum File No
Dim intPos As Integer 'Position ??
Dim intSeq As Integer 'Sequence
Dim FF As String 'Final File
Dim strFolderName As String
Dim fso As FileSystemObject
Dim IP As ImageProcess
Dim img As ImageFile
'Check if list contains any selections
On Error Resume Next
If lstImages.ListCount = 0 Then
MsgBox "No Images To Select", vbInformation, "Information"
Exit Sub
End If
If lstImages.SelCount = 0 Then
MsgBox "No Images Selected", vbInformation, "Information"
Exit Sub
End If
JN = InputBox("Job Number", "")
'Ensure Job No is entered
If JN = "" Then
MsgBox "You Have Missed a Job No Or A Registration No" & vbCrLf & _
"Please Try Again", vbInformation, "Information": Exit Sub
End If
If IsNumeric(JN) Then 'Check If Estimate Number or Registration
'Do the stuff
' Determine maximum sequence number used up to now
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 = InStr(fn, ".")
If intPos > 0 Then
intSeq = Val(Mid(fn, intPos - 2, 2))
If intSeq > intMax Then
intMax = intSeq
End If
End If
fn = Dir
Loop
AN = Dir(AP & JN & "-??.jpg")
Do Until AN = ""
intPos = InStr(AN, ".")
If intPos > 0 Then
intSeq = Val(Mid(AN, intPos - 2, 2))
If intSeq > intMax Then
intMax = intSeq
End If
End If
AN = Dir
Loop
' Now loop through the items of the list box ***************************
Set img = CreateObject("WIA.ImageFile")
Set IP = CreateObject("WIA.ImageProcess")
For N = 0 To lstImages.ListCount - 1
If lstImages.Selected(N) Then
' Increase the sequence number for the next file
intMax = intMax + 1
If intMax = 99 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, "00") & ".jpg"
ImgConvert lstImages.List(N), strFolderName & FF, True
img.LoadFile strFolderName & FF
'Update the log file
WriteLog GetNetUser & " File " & lstImages.List(N) & " Was Copied To " & DP & FF
End If
Next N
Else
WriteLog GetNetUser & " Invalid Job Number Using Import"
MsgBox JN & " " & "Is Not A Valid Job Number" & vbCrLf & _
"You Must Create A Valid Estimate Number", vbCritical, "Job No Error": Exit Sub
End If
'Tell user files have been exported
If MsgBox("Do You Want To Remove These Images From The Card ?." & _
" These Images Will Not Be Retrievable !!?", vbYesNo + vbQuestion, " Clear Card") = vbYes Then
Set fso = New FileSystemObject
For N = 0 To lstImages.ListCount - 1
If lstImages.Selected(N) Then
fso.DeleteFile lstImages.List(N)
lstImages.Refresh
End If
Next N
End If
Set fso = Nothing
Unload Me
End Sub