لعدم وجود سكانر عندي ، وددت المشاركة بمصادر قد تفيد إن لم تكن مجربة من قبل ،
الفكرة الأولى :-
option Compare Database
Option Explicit
Const WIA_FORMAT_JPEG = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"
Public Sub ScanDocs()
Dim intPages As Integer 'number of pages
Dim img As WIA.ImageFile
Dim strPath As String
Dim strFileJPG As String
strPath = CurrentProject.Path 'set path to save files
intPages = 1
On Error GoTo ErrorHandler
'scan
ScanStrat:
Dim DialogScan As New WIA.CommonDialog, dpi As Integer, pp As Integer, l As Integer
dpi = 250
Dim Scanner As WIA.Device
Set Scanner = DialogScan.ShowSelectDevice(WIA.WiaDeviceType.ScannerDeviceType, False, False)
'set properties device
Scanner.Properties("3088").Value = 1 'Automatic Document Feeder
Scanner.Items(1).Properties("6146").Value = 4 'Colour intent
Scanner.Items(1).Properties("6147").Value = dpi 'DPI horizontal
Scanner.Items(1).Properties("6148").Value = dpi 'DPI vertical
Scanner.Items(1).Properties("6149").Value = 0 'x point to start scan
Scanner.Items(1).Properties("6150").Value = 0 'y point to start scan
Scanner.Items(1).Properties("6151").Value = 8.27 * dpi 'Horizontal extent
Scanner.Items(1).Properties("6152").Value = 11.7 * dpi 'Vertical extent for A4
Scanner.Items(1).Properties("6154").Value = 80 'brightness
' Scanner.Items(1).Properties("6155").Value = 30 'contrast
'Start Scan if err number -2145320957 Scan document finish
Do While Err.Number <> -2145320957 'error number is ADF status don't feed document
Set img = Scanner.Items(1).Transfer(WIA_FORMAT_JPEG)
strFileJPG = strPath & "\FileScan\temp\" & CStr(intPages) & ".jpg"
img.SaveFile (strFileJPG) 'save files .jpg in temp folder
DoCmd.SetWarnings False
DoCmd.RunSQL "insert into scantemp (picture) values ('" & strFileJPG & "')" 'insert picture temp to table scan temp
intPages = intPages + 1 'add number pages
Loop
'after finish scan start convert to pdf
StartPDFConversion:
Dim strFilePDF As String '
Dim RptName As String
strFilePDF = CurrentProject.Path & "\FileScan\" & txt_id.Value & ".pdf" 'pdf file name by textbox
RptName = "rptScan" 'report picture file for export to PDF
DoCmd.OpenReport RptName, acViewDesign, , , acHidden
DoCmd.Close acReport, RptName, acSaveYes
DoCmd.OutputTo acOutputReport, RptName, acFormatPDF, strFilePDF
DoCmd.RunSQL "delete from scantemp" 'delete all data from table scantemp
DeleteTemp:
'delete files temp (JPG)
Dim i As Integer
Dim filesname As String
i = 1
'loop pages number (intpages)
Do While i < intPages
filesname = CurrentProject.Path & "\FileScan\temp\" & i & ".jpg"
If Dir(filesname) <> "" Then
'SetAttr filesname, vbNormal
Kill filesname
Else
Exit Do
End If
i = i + 1
Loop
MsgBox ("done")
Exit Sub
ErrorHandler:
Select Case Err.Number
Case -2145320957
If intPages = 1 Then
MsgBox ("not found document to scan")
Exit Sub
Else
GoTo StartPDFConversion
End If
End Select
MsgBox "Error" & ": " & Err.Number & vbCrLf & "Description: " _
& Err.Description, vbExclamation, Me.Name & ".ScanDocs"
End Sub
المصدر :
الفكرة الثانية :-
المصدر :
* ولتأكيد المعلومة مرة أخرى ؛ أنا لم أقم بتجربة الأكواد لعدم امتلاكي سكانر للتأكد من صحة المواقع .