Soru WIA ile Tarama Yapma

[hlojan]

Merhaba;

WIA ile tarama yapmak istiyorum. Bir tane kod buldum

  Dim objCommonDialog As WIA.CommonDialog
  Dim objImage As WIA.ImageFile
  Dim strFilePath As String
  ' instantiate Scan WIA objects
  Set objCommonDialog = New WIA.CommonDialog
  Set objImage = objCommonDialog.ShowAcquireImage
  strFilePath = ThisWorkbook.Path & "\Scan.jpg" ' set temporary file
  If Not objImage Is Nothing Then
    If Dir(strFilePath) <> "" Then Kill strFilePath
    objImage.SaveFile strFilePath 'save into temp file
    DoEvents
End If

Dialog Box açılıyor. Seçenekleri seçince Tarama yapıyor . Kaydediyor. Düzgün çalışıyor
Ben standart seçenekleri seçerek ilerlesin istiyorum.

1. Besleyici ( adf olarak taramayacağım tek tek tarayacağım . 1 sayfa 1 sayfa)
2. Siyah Beyaz
3. A4

Bunları seçmeden direk taramasını istiyorum.

Bunun için aşağıdaki adresi araştırdım ama bulamadım.
Windows Image Acquisition Automation Layer | Microsoft Docs

2. Adım daha basit belki ilk adımı çözdükten sonra bir şekilde çözerim.

Taranan dosyayı a6 ya yapıştırıp d1 hücresinden dosya ismi ile belirli bir yere kaydetmek

Şimdiden teşekkürler

 

[hlojan]

Ek olarak aşağıdaki kodu buldum
Ama denemelerim boşa çıktı.
.Properties ile yapılabilir gibi duruyor. Belki yardımı olur diye ekleym dedim

Dim WiaObj As WIA.CommonDialog
        Dim WiaItm As WIA.Item
        Dim WiaImg As New WIA.ImageFile
        Dim WiaDev As WIA.Device
 
        WiaObj = New WIA.CommonDialog
 
        If WiaDev Is Nothing Then     ' WiaDev is defined globally
            WiaDev = WiaObj.ShowSelectDevice(WIA.WiaDeviceType.ScannerDeviceType, True, False)
 
        End If
        WiaDev.Properties("3088").Value = 1  '1 for feeder, 2 for flatbed
        Dim Itm As WIA.Item
        Dim ItmProp As WIA.Property
        Itm = WiaDev.Items(1)
        'Itm.Properties("6146").Value = WIA.WiaImageIntent.TextIntent
        Itm.Properties("6146").Value = 4   '(gray is 2, color 1, bw 4, unspecified 0
        Itm.Properties("6147").Value = 100  ' Horizontal Resolution
        Itm.Properties("6148").Value = 100   ' Vertical Resolution
        Itm.Properties("6151").Value = 100   ' Horizontal Extent (Scanning Area)
        Itm.Properties("6152").Value = 100    ' Vertical Extent (Scanning Area)
        Itm.Properties("6149").Value = 0  ' Horizontal Starting Position (Scanning Area)
        Itm.Properties("6150").Value = 0  ' Vertical Starting Position (Scanning Area)
        ' Add this and it worked!!!!!!!!!!!!!!
        MsgBox(WiaDev.Properties("3088").Value.ToString)
 
        WiaImg = WiaObj.ShowTransfer(Itm)
 
        ' Save file   
        Dim IP As ImageProcess
        IP = CreateObject("WIA.ImageProcess")
        IP.Filters.Add(IP.FilterInfos("Convert").FilterID)
        IP.Filters(1).Properties("FormatID").Value = WIA.FormatID.wiaFormatJPEG
        IP.Filters(1).Properties("Quality").Value = 60
        WiaImg = IP.Apply(WiaImg)
        If System.IO.File.Exists("C:\J.jpg") Then
            System.IO.File.Delete("C:\J.jpg")
        End If
        WiaImg.SaveFile("C:\J.jpg")

 

[hlojan]

Deneme Yanılma ile buldum. İnternette ADF ( Besleyici ) den tarama yapmak için çok az örnek olduğuğu için sizle paylaşmak istedim
Başarılı bir şekilde çalıştı.

Dim wiaImg As New WIA.ImageFile
Dim wiaDialog As New WIA.CommonDialog
Dim wiaScanner As WIA.device
Dim strFilePath As String
Dim strFilename As String
Set wiaScanner = wiaDialog.ShowSelectDevice
wiaScanner.Properties("3088").Value = 1
With wiaScanner.Items(1)
.Properties("6146").Value = 4 '4 is Black-white,gray is 2, color 1 (Color Intent)
.Properties("6147").Value = 200 'dots per inch/horizontal
.Properties("6148").Value = 200 'dots per inch/vertical
.Properties("6149").Value = 0 'x point where to start scan
.Properties("6150").Value = 0 'y-point where to start scan
.Properties("6151").Value = 1660 'horizontal exent DPI x inches wide
.Properties("6152").Value = 2334 'vertical extent DPI x inches tall
' Available formats
' wiaFormatBMP, wiaFormatPNG, wiaFormatGIF, wiaFormatJPEG, wiaFormatTIFF
' Change file file extension in strFilename to match format
Set wiaImg = wiaScanner.Items(1).Transfer(wiaFormatJPEG)
End With
'Set the filename
strFilename = "Scan-" & Format(Now, "yyyymmddhhmm") & ".jpg"
' set the file path
strFilePath = ThisWorkbook.Path & "\" & strFilename ' set temporary file
' Check if filename exists, if so, delete before saving new
    If Dir(strFilePath) <> "" Then Kill strFilePath
      wiaImg.SaveFile strFilePath 'save into temp file
    DoEvents
Set wiaImg = Nothing
Set wiaScanner = Nothing