Hello all,
I have some code set up to automate scanning from access to a specific folder on the server. I have searched the web for different codes and have not come across anything that will scan an unknown amount of documents. The best I found was the code I am currently using, that will scan up to 10 documents separately, then convert these documents into 1 PDF. This is not ideal, however, because it would require the user to scan 1 document, wait, than scan another, wait, etc. Also, the code I am currently using will only scan from the glass, not the auto feeder, and I am unsure how to change this. Any ideas or knowledge of a better code to suit my needs? Thanks!
Private Sub cmdCOC_Click()
'scan COC
On Error GoTo Err_Handler
Const DEVNAME As String = "Brother MFC-7860DW LAN"
Dim ComDialog As WIA.CommonDialog
Dim DevMgr As WIA.DeviceManager
Dim DevInfo As WIA.DeviceInfo
Dim dev As WIA.Device
Dim img As WIA.ImageFile
Dim i, dpi As Integer
Dim strDir, pfile, strFileJPG, RptName As String
Dim bShowProgress As Boolean
Dim FSO As New FileSystemObject
DoCmd.SetWarnings False
DoCmd.RunSQL "delete from scantemp"
DoCmd.SetWarnings True
Set DevMgr = New WIA.DeviceManager
strDir = Me.Folder
pfile = ("COC - " & Me.ProjectName & (" (NL - ") & Me.IDNumber & (")"))
strFileJPG = strDir & "\" & pfile & ".jpg"
dpi = 300
For i = 1 To DevMgr.DeviceInfos().Count
If DevMgr.DeviceInfos(i).Properties("Name") = DEVNAME Then
Set DevInfo = DevMgr.DeviceInfos(i)
End If
Next i
Set dev = DevInfo.Connect
Set img = dev.Items(1).Transfer(WIA.FormatID.wiaFormatJPEG)
img.SaveFile strFileJPG
'prompt for additional pages
Dim intPages As Integer
intPages = 1
Dim Answer2 As String
Dim mynote2 As String
mynote2 = "Scan another page?"
Answer2 = MsgBox(mynote2, vbQuestion + vbYesNo, "Additional Pages")
If Answer2 = vbNo Then
GoTo StartPDFConversion
Else
Dim img2 As WIA.ImageFile
Set img2 = dev.Items(1).Transfer(WIA.FormatID.wiaFormatJPEG)
Dim strFileJPG2 As String
strFileJPG2 = strDir & "\" & pfile & "2.jpg"
img2.SaveFile strFileJPG2
intPages = intPages + 1
End If
'prompt for additional pages
Dim Answer3 As String
Dim mynote3 As String
mynote3 = "Scan another page?"
Answer3 = MsgBox(mynote3, vbQuestion + vbYesNo, "Additional Pages")
If Answer3 = vbNo Then
GoTo StartPDFConversion
Else
Dim img3 As WIA.ImageFile
Set img3 = dev.Items(1).Transfer(WIA.FormatID.wiaFormatJPEG)
Dim strFileJPG3 As String
strFileJPG3 = strDir & "\" & pfile & "3.jpg"
img3.SaveFile strFileJPG3
intPages = intPages + 1
End If
'prompt for additional pages
Dim Answer4 As String
Dim mynote4 As String
mynote4 = "Scan another page?"
Answer4 = MsgBox(mynote4, vbQuestion + vbYesNo, "Additional Pages")
If Answer4 = vbNo Then
GoTo StartPDFConversion
Else
Dim img4 As WIA.ImageFile
Set img4 = dev.Items(1).Transfer(WIA.FormatID.wiaFormatJPEG)
Dim strFileJPG4 As String
strFileJPG4 = strDir & "\" & pfile & "4.jpg"
img4.SaveFile strFileJPG4
intPages = intPages + 1
End If
'prompt for additional pages
Dim Answer5 As String
Dim mynote5 As String
mynote5 = "Scan another page?"
Answer5 = MsgBox(mynote5, vbQuestion + vbYesNo, "Additional Pages")
If Answer5 = vbNo Then
GoTo StartPDFConversion
Else
Dim img5 As WIA.ImageFile
Set img5 = dev.Items(1).Transfer(WIA.FormatID.wiaFormatJPEG)
Dim strFileJPG5 As String
strFileJPG5 = strDir & "\" & pfile & "5.jpg"
img5.SaveFile strFileJPG5
intPages = intPages + 1
End If
'prompt for additional pages
Dim Answer6 As String
Dim mynote6 As String
mynote6 = "Scan another page?"
Answer6 = MsgBox(mynote6, vbQuestion + vbYesNo, "Additional Pages")
If Answer6 = vbNo Then
GoTo StartPDFConversion
Else
Dim img6 As WIA.ImageFile
Set img6 = dev.Items(1).Transfer(WIA.FormatID.wiaFormatJPEG)
Dim strFileJPG6 As String
strFileJPG6 = strDir & "\" & pfile & "6.jpg"
img6.SaveFile strFileJPG6
intPages = intPages + 1
End If
'prompt for additional pages
Dim Answer7 As String
Dim mynote7 As String
mynote7 = "Scan another page?"
Answer7 = MsgBox(mynote7, vbQuestion + vbYesNo, "Additional Pages")
If Answer7 = vbNo Then
GoTo StartPDFConversion
Else
Dim img7 As WIA.ImageFile
Set img7 = dev.Items(1).Transfer(WIA.FormatID.wiaFormatJPEG)
Dim strFileJPG7 As String
strFileJPG7 = strDir & "\" & pfile & "7.jpg"
img7.SaveFile strFileJPG7
intPages = intPages + 1
End If
'prompt for additional pages
Dim Answer8 As String
Dim mynote8 As String
mynote8 = "Scan another page?"
Answer8 = MsgBox(mynote8, vbQuestion + vbYesNo, "Additional Pages")
If Answer8 = vbNo Then
GoTo StartPDFConversion
Else
Dim img8 As WIA.ImageFile
Set img8 = dev.Items(1).Transfer(WIA.FormatID.wiaFormatJPEG)
Dim strFileJPG8 As String
strFileJPG8 = strDir & "\" & pfile & "8.jpg"
img8.SaveFile strFileJPG8
intPages = intPages + 1
End If
'prompt for additional pages
Dim Answer9 As String
Dim mynote9 As String
mynote9 = "Scan another page?"
Answer9 = MsgBox(mynote9, vbQuestion + vbYesNo, "Additional Pages")
If Answer9 = vbNo Then
GoTo StartPDFConversion
Else
Dim img9 As WIA.ImageFile
Set img9 = dev.Items(1).Transfer(WIA.FormatID.wiaFormatJPEG)
Dim strFileJPG9 As String
strFileJPG9 = strDir & "\" & pfile & "9.jpg"
img9.SaveFile strFileJPG9
intPages = intPages + 1
End If
'prompt for additional pages
Dim Answer10 As String
Dim mynote10 As String
mynote10 = "Scan another page?"
Answer10 = MsgBox(mynote10, vbQuestion + vbYesNo, "Additional Pages")
If Answer10 = vbNo Then
GoTo StartPDFConversion
Else
Dim img10 As WIA.ImageFile
Set img10 = dev.Items(1).Transfer(WIA.FormatID.wiaFormatJPEG)
Dim strFileJPG10 As String
strFileJPG10 = strDir & "\" & pfile & "10.jpg"
img10.SaveFile strFileJPG10
intPages = intPages + 1
End If
Set img = Nothing
Set dev = Nothing
Set DevInfo = Nothing
Set DevMgr = Nothing
Set ComDialog = Nothing
strFile = ""
StartPDFConversion:
strFile = strDir & "\" & pfile & ".pdf"
If FSO.FileExists(strFile) Then
FSO.DeleteFile (strFile)
End If
Set FSO = Nothing
DoCmd.SetWarnings False
DoCmd.RunSQL "insert into scantemp (Picture) values ('" & strFileJPG & "')"
If intPages >= 2 Then
DoCmd.RunSQL "inset into scantemp (Picture) values ('" & strFileJPG2 & "')"""
End If
If intPages >= 3 Then
DoCmd.RunSQL "inset into scantemp (Picture) values ('" & strFileJPG3 & "')"""
End If
If intPages >= 4 Then
DoCmd.RunSQL "inset into scantemp (Picture) values ('" & strFileJPG4 & "')"""
End If
If intPages >= 5 Then
DoCmd.RunSQL "inset into scantemp (Picture) values ('" & strFileJPG5 & "')"""
End If
If intPages >= 6 Then
DoCmd.RunSQL "inset into scantemp (Picture) values ('" & strFileJPG6 & "')"""
End If
If intPages >= 7 Then
DoCmd.RunSQL "inset into scantemp (Picture) values ('" & strFileJPG7 & "')"""
End If
If intPages >= 8 Then
DoCmd.RunSQL "inset into scantemp (Picture) values ('" & strFileJPG8 & "')"""
End If
If intPages >= 9 Then
DoCmd.RunSQL "inset into scantemp (Picture) values ('" & strFileJPG9 & "')"""
End If
If intPages >= 10 Then
DoCmd.RunSQL "inset into scantemp (Picture) values ('" & strFileJPG10 & "')"""
End If
DoCmd.SetWarnings True
'generate pdf
RptName = "RptScan"
DoCmd.OpenReport RptName, acViewReport, , , acHidden
DoCmd.Close acReport, RptName, acSaveYes
DoCmd.OutputTo acOutputReport, RptName, acFormatPDF, strFile
'clear out image files
Dim fso46 As New FileSystemObject
fso46.DeleteFile strFileJPG
If intPages = 2 Then
fso46.DeleteFile strFileJPG2
ElseIf intPages = 3 Then
fso46.DeleteFile strFileJPG2
fso46.DeleteFile strFileJPG3
ElseIf intPages = 4 Then
fso46.DeleteFile strFileJPG2
fso46.DeleteFile strFileJPG3
fso46.DeleteFile strFileJPG4
ElseIf intPages = 5 Then
fso46.DeleteFile strFileJPG2
fso46.DeleteFile strFileJPG3
fso46.DeleteFile strFileJPG4
fso46.DeleteFile strFileJPG5
ElseIf intPages = 6 Then
fso46.DeleteFile strFileJPG2
fso46.DeleteFile strFileJPG3
fso46.DeleteFile strFileJPG4
fso46.DeleteFile strFileJPG5
fso46.DeleteFile strFileJPG6
ElseIf intPages = 7 Then
fso46.DeleteFile strFileJPG2
fso46.DeleteFile strFileJPG3
fso46.DeleteFile strFileJPG4
fso46.DeleteFile strFileJPG5
fso46.DeleteFile strFileJPG6
fso46.DeleteFile strFileJPG7
ElseIf intPages = 8 Then
fso46.DeleteFile strFileJPG2
fso46.DeleteFile strFileJPG3
fso46.DeleteFile strFileJPG4
fso46.DeleteFile strFileJPG5
fso46.DeleteFile strFileJPG6
fso46.DeleteFile strFileJPG7
fso46.DeleteFile strFileJPG8
ElseIf intPages = 9 Then
fso46.DeleteFile strFileJPG2
fso46.DeleteFile strFileJPG3
fso46.DeleteFile strFileJPG4
fso46.DeleteFile strFileJPG5
fso46.DeleteFile strFileJPG6
fso46.DeleteFile strFileJPG7
fso46.DeleteFile strFileJPG8
fso46.DeleteFile strFileJPG9
ElseIf intPages = 10 Then
fso46.DeleteFile strFileJPG2
fso46.DeleteFile strFileJPG3
fso46.DeleteFile strFileJPG4
fso46.DeleteFile strFileJPG5
fso46.DeleteFile strFileJPG6
fso46.DeleteFile strFileJPG7
fso46.DeleteFile strFileJPG8
fso46.DeleteFile strFileJPG9
fso46.DeleteFile strFileJPG10
End If
Set fso46 = Nothing
'add hyperlink to COC field
Me.COC = "#" & strFile & "#"
MsgBox "Then Chain of Custody has been saved to file", , "Scan Completed"
Err_Handler:
If Err.Description = "An error has occurred with the scanning process. Check to make sure paper is properly places in scanner and try again." Then
Resume
Else
Debug.Print Err.Description
Exit Sub
End If
End Sub
I have some code set up to automate scanning from access to a specific folder on the server. I have searched the web for different codes and have not come across anything that will scan an unknown amount of documents. The best I found was the code I am currently using, that will scan up to 10 documents separately, then convert these documents into 1 PDF. This is not ideal, however, because it would require the user to scan 1 document, wait, than scan another, wait, etc. Also, the code I am currently using will only scan from the glass, not the auto feeder, and I am unsure how to change this. Any ideas or knowledge of a better code to suit my needs? Thanks!
Private Sub cmdCOC_Click()
'scan COC
On Error GoTo Err_Handler
Const DEVNAME As String = "Brother MFC-7860DW LAN"
Dim ComDialog As WIA.CommonDialog
Dim DevMgr As WIA.DeviceManager
Dim DevInfo As WIA.DeviceInfo
Dim dev As WIA.Device
Dim img As WIA.ImageFile
Dim i, dpi As Integer
Dim strDir, pfile, strFileJPG, RptName As String
Dim bShowProgress As Boolean
Dim FSO As New FileSystemObject
DoCmd.SetWarnings False
DoCmd.RunSQL "delete from scantemp"
DoCmd.SetWarnings True
Set DevMgr = New WIA.DeviceManager
strDir = Me.Folder
pfile = ("COC - " & Me.ProjectName & (" (NL - ") & Me.IDNumber & (")"))
strFileJPG = strDir & "\" & pfile & ".jpg"
dpi = 300
For i = 1 To DevMgr.DeviceInfos().Count
If DevMgr.DeviceInfos(i).Properties("Name") = DEVNAME Then
Set DevInfo = DevMgr.DeviceInfos(i)
End If
Next i
Set dev = DevInfo.Connect
Set img = dev.Items(1).Transfer(WIA.FormatID.wiaFormatJPEG)
img.SaveFile strFileJPG
'prompt for additional pages
Dim intPages As Integer
intPages = 1
Dim Answer2 As String
Dim mynote2 As String
mynote2 = "Scan another page?"
Answer2 = MsgBox(mynote2, vbQuestion + vbYesNo, "Additional Pages")
If Answer2 = vbNo Then
GoTo StartPDFConversion
Else
Dim img2 As WIA.ImageFile
Set img2 = dev.Items(1).Transfer(WIA.FormatID.wiaFormatJPEG)
Dim strFileJPG2 As String
strFileJPG2 = strDir & "\" & pfile & "2.jpg"
img2.SaveFile strFileJPG2
intPages = intPages + 1
End If
'prompt for additional pages
Dim Answer3 As String
Dim mynote3 As String
mynote3 = "Scan another page?"
Answer3 = MsgBox(mynote3, vbQuestion + vbYesNo, "Additional Pages")
If Answer3 = vbNo Then
GoTo StartPDFConversion
Else
Dim img3 As WIA.ImageFile
Set img3 = dev.Items(1).Transfer(WIA.FormatID.wiaFormatJPEG)
Dim strFileJPG3 As String
strFileJPG3 = strDir & "\" & pfile & "3.jpg"
img3.SaveFile strFileJPG3
intPages = intPages + 1
End If
'prompt for additional pages
Dim Answer4 As String
Dim mynote4 As String
mynote4 = "Scan another page?"
Answer4 = MsgBox(mynote4, vbQuestion + vbYesNo, "Additional Pages")
If Answer4 = vbNo Then
GoTo StartPDFConversion
Else
Dim img4 As WIA.ImageFile
Set img4 = dev.Items(1).Transfer(WIA.FormatID.wiaFormatJPEG)
Dim strFileJPG4 As String
strFileJPG4 = strDir & "\" & pfile & "4.jpg"
img4.SaveFile strFileJPG4
intPages = intPages + 1
End If
'prompt for additional pages
Dim Answer5 As String
Dim mynote5 As String
mynote5 = "Scan another page?"
Answer5 = MsgBox(mynote5, vbQuestion + vbYesNo, "Additional Pages")
If Answer5 = vbNo Then
GoTo StartPDFConversion
Else
Dim img5 As WIA.ImageFile
Set img5 = dev.Items(1).Transfer(WIA.FormatID.wiaFormatJPEG)
Dim strFileJPG5 As String
strFileJPG5 = strDir & "\" & pfile & "5.jpg"
img5.SaveFile strFileJPG5
intPages = intPages + 1
End If
'prompt for additional pages
Dim Answer6 As String
Dim mynote6 As String
mynote6 = "Scan another page?"
Answer6 = MsgBox(mynote6, vbQuestion + vbYesNo, "Additional Pages")
If Answer6 = vbNo Then
GoTo StartPDFConversion
Else
Dim img6 As WIA.ImageFile
Set img6 = dev.Items(1).Transfer(WIA.FormatID.wiaFormatJPEG)
Dim strFileJPG6 As String
strFileJPG6 = strDir & "\" & pfile & "6.jpg"
img6.SaveFile strFileJPG6
intPages = intPages + 1
End If
'prompt for additional pages
Dim Answer7 As String
Dim mynote7 As String
mynote7 = "Scan another page?"
Answer7 = MsgBox(mynote7, vbQuestion + vbYesNo, "Additional Pages")
If Answer7 = vbNo Then
GoTo StartPDFConversion
Else
Dim img7 As WIA.ImageFile
Set img7 = dev.Items(1).Transfer(WIA.FormatID.wiaFormatJPEG)
Dim strFileJPG7 As String
strFileJPG7 = strDir & "\" & pfile & "7.jpg"
img7.SaveFile strFileJPG7
intPages = intPages + 1
End If
'prompt for additional pages
Dim Answer8 As String
Dim mynote8 As String
mynote8 = "Scan another page?"
Answer8 = MsgBox(mynote8, vbQuestion + vbYesNo, "Additional Pages")
If Answer8 = vbNo Then
GoTo StartPDFConversion
Else
Dim img8 As WIA.ImageFile
Set img8 = dev.Items(1).Transfer(WIA.FormatID.wiaFormatJPEG)
Dim strFileJPG8 As String
strFileJPG8 = strDir & "\" & pfile & "8.jpg"
img8.SaveFile strFileJPG8
intPages = intPages + 1
End If
'prompt for additional pages
Dim Answer9 As String
Dim mynote9 As String
mynote9 = "Scan another page?"
Answer9 = MsgBox(mynote9, vbQuestion + vbYesNo, "Additional Pages")
If Answer9 = vbNo Then
GoTo StartPDFConversion
Else
Dim img9 As WIA.ImageFile
Set img9 = dev.Items(1).Transfer(WIA.FormatID.wiaFormatJPEG)
Dim strFileJPG9 As String
strFileJPG9 = strDir & "\" & pfile & "9.jpg"
img9.SaveFile strFileJPG9
intPages = intPages + 1
End If
'prompt for additional pages
Dim Answer10 As String
Dim mynote10 As String
mynote10 = "Scan another page?"
Answer10 = MsgBox(mynote10, vbQuestion + vbYesNo, "Additional Pages")
If Answer10 = vbNo Then
GoTo StartPDFConversion
Else
Dim img10 As WIA.ImageFile
Set img10 = dev.Items(1).Transfer(WIA.FormatID.wiaFormatJPEG)
Dim strFileJPG10 As String
strFileJPG10 = strDir & "\" & pfile & "10.jpg"
img10.SaveFile strFileJPG10
intPages = intPages + 1
End If
Set img = Nothing
Set dev = Nothing
Set DevInfo = Nothing
Set DevMgr = Nothing
Set ComDialog = Nothing
strFile = ""
StartPDFConversion:
strFile = strDir & "\" & pfile & ".pdf"
If FSO.FileExists(strFile) Then
FSO.DeleteFile (strFile)
End If
Set FSO = Nothing
DoCmd.SetWarnings False
DoCmd.RunSQL "insert into scantemp (Picture) values ('" & strFileJPG & "')"
If intPages >= 2 Then
DoCmd.RunSQL "inset into scantemp (Picture) values ('" & strFileJPG2 & "')"""
End If
If intPages >= 3 Then
DoCmd.RunSQL "inset into scantemp (Picture) values ('" & strFileJPG3 & "')"""
End If
If intPages >= 4 Then
DoCmd.RunSQL "inset into scantemp (Picture) values ('" & strFileJPG4 & "')"""
End If
If intPages >= 5 Then
DoCmd.RunSQL "inset into scantemp (Picture) values ('" & strFileJPG5 & "')"""
End If
If intPages >= 6 Then
DoCmd.RunSQL "inset into scantemp (Picture) values ('" & strFileJPG6 & "')"""
End If
If intPages >= 7 Then
DoCmd.RunSQL "inset into scantemp (Picture) values ('" & strFileJPG7 & "')"""
End If
If intPages >= 8 Then
DoCmd.RunSQL "inset into scantemp (Picture) values ('" & strFileJPG8 & "')"""
End If
If intPages >= 9 Then
DoCmd.RunSQL "inset into scantemp (Picture) values ('" & strFileJPG9 & "')"""
End If
If intPages >= 10 Then
DoCmd.RunSQL "inset into scantemp (Picture) values ('" & strFileJPG10 & "')"""
End If
DoCmd.SetWarnings True
'generate pdf
RptName = "RptScan"
DoCmd.OpenReport RptName, acViewReport, , , acHidden
DoCmd.Close acReport, RptName, acSaveYes
DoCmd.OutputTo acOutputReport, RptName, acFormatPDF, strFile
'clear out image files
Dim fso46 As New FileSystemObject
fso46.DeleteFile strFileJPG
If intPages = 2 Then
fso46.DeleteFile strFileJPG2
ElseIf intPages = 3 Then
fso46.DeleteFile strFileJPG2
fso46.DeleteFile strFileJPG3
ElseIf intPages = 4 Then
fso46.DeleteFile strFileJPG2
fso46.DeleteFile strFileJPG3
fso46.DeleteFile strFileJPG4
ElseIf intPages = 5 Then
fso46.DeleteFile strFileJPG2
fso46.DeleteFile strFileJPG3
fso46.DeleteFile strFileJPG4
fso46.DeleteFile strFileJPG5
ElseIf intPages = 6 Then
fso46.DeleteFile strFileJPG2
fso46.DeleteFile strFileJPG3
fso46.DeleteFile strFileJPG4
fso46.DeleteFile strFileJPG5
fso46.DeleteFile strFileJPG6
ElseIf intPages = 7 Then
fso46.DeleteFile strFileJPG2
fso46.DeleteFile strFileJPG3
fso46.DeleteFile strFileJPG4
fso46.DeleteFile strFileJPG5
fso46.DeleteFile strFileJPG6
fso46.DeleteFile strFileJPG7
ElseIf intPages = 8 Then
fso46.DeleteFile strFileJPG2
fso46.DeleteFile strFileJPG3
fso46.DeleteFile strFileJPG4
fso46.DeleteFile strFileJPG5
fso46.DeleteFile strFileJPG6
fso46.DeleteFile strFileJPG7
fso46.DeleteFile strFileJPG8
ElseIf intPages = 9 Then
fso46.DeleteFile strFileJPG2
fso46.DeleteFile strFileJPG3
fso46.DeleteFile strFileJPG4
fso46.DeleteFile strFileJPG5
fso46.DeleteFile strFileJPG6
fso46.DeleteFile strFileJPG7
fso46.DeleteFile strFileJPG8
fso46.DeleteFile strFileJPG9
ElseIf intPages = 10 Then
fso46.DeleteFile strFileJPG2
fso46.DeleteFile strFileJPG3
fso46.DeleteFile strFileJPG4
fso46.DeleteFile strFileJPG5
fso46.DeleteFile strFileJPG6
fso46.DeleteFile strFileJPG7
fso46.DeleteFile strFileJPG8
fso46.DeleteFile strFileJPG9
fso46.DeleteFile strFileJPG10
End If
Set fso46 = Nothing
'add hyperlink to COC field
Me.COC = "#" & strFile & "#"
MsgBox "Then Chain of Custody has been saved to file", , "Scan Completed"
Err_Handler:
If Err.Description = "An error has occurred with the scanning process. Check to make sure paper is properly places in scanner and try again." Then
Resume
Else
Debug.Print Err.Description
Exit Sub
End If
End Sub
