EXCEL FEED: [ExcelVBA] Scanning via VBA programming

I found the below VBA code on the internet.

I am having a problem with the following line of coding:

Set wiaImg = .Transfer(wiaFormatJPEG) 'Change file type in save to match format

It is giving me a compile error that it cannot find project or library

On a test file, this code worked perfectly however when I inserted the code in a file I want to work with, it immediately started to give the above problem.

In both the test file and the main file I inserted the library reference "Microsoft Windows Image Acquisition" as instructed by the one who put this code on the internet.

Can anyone please help and suggest what may be wrong and why it works perfectly in one file but not in another?

Thanks & regards

Vince

Sub ScanDoc()

'message to put the document in the scanner for scanning

MsgBox ("Place certificate in scanner for scanning")

Dim wiaImg As New WIA.ImageFile

Dim wiaDialog As New WIA.CommonDialog

Dim wiaScanner As WIA.Device

Set wiaScanner = wiaDialog.ShowSelectDevice

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



    'Following is A4 paper size. _

     '(Not 100% accurate because real A4 Ht errors)

    '.Properties("6151").Value = 830 'horizontal exent DPI x inches wide

    '.Properties("6152").Value = 1167 'vertical extent DPI x inches tall

    ' setting my personal values
    .Properties("6151").Value = 1600 'horizontal exent DPI x inches wide

    .Properties("6152").Value = 2200 'vertical extent DPI x inches tall

    Set wiaImg = .Transfer(wiaFormatJPEG) 'Change file type in save to match format



End With

'*************************************************************

'Between asterisk lines is because Save errors if file exists

If Dir("c:\delete\MyImage.jpg") <> "" Then



    Kill "c:\delete\MyImage.jpg"

End If

'**************************************************************

wiaImg.SaveFile ("c:\delete\MyImage.jpg")

Set wiaImg = Nothing

Set wiaScanner = Nothing

Call printpdf

End Sub

Sub printpdf()

Dim ws As Worksheet
Dim pic As Picture

Application.ScreenUpdating = False

Application.Goto Reference:="pos_Temp"
ActiveCell.Activate

Set ws = ActiveSheet
ws.PageSetup.PaperSize = xlPaperA4
'Can also specify margins, etc.

ws.Range("A1").Activate
'Set pic = ws.Pictures.Insert("c:\delete\MyImage.png")
Set pic = ws.Pictures.Insert("c:\delete\MyImage.jpg")

'Set picture size.
With pic.ShapeRange
    .LockAspectRatio = msoFalse
    .Height = Application.CentimetersToPoints(20)
    .Width = Application.CentimetersToPoints(15)
    'Or you could match the size to the paper margins from above.
End With

'Between asterisk lines is because of Save errors if file exists

    'If Dir("c:\delete\MyImage.pdf") <> "" Then

    'Kill "c:\delete\MyImage.pdf"

    If Dir(chrPath & chrCertificate & ".pdf") <> "" Then

    Kill chrPath & chrCertificate & ".pdf"

    End If

ws.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=chrPath & chrCertificate & ".pdf", OpenAfterPublish:=True

    Application.Goto Reference:="pos_pathname"
    ActiveCell.Activate

    Application.ScreenUpdating = True

End Sub

__._,_.___

Posted by: vince19472003@yahoo.com

Reply via web post

•

Reply to sender

•

Reply to group

•

Start a New Topic

•

Messages in this topic (1)

Have you tried the highest rated email app?

With 4.5 stars in iTunes, the Yahoo Mail app is the highest rated email app on the market. What are you waiting for? Now you can access all your inboxes (Gmail, Outlook, AOL and more) in one place. Never delete an email again with 1000GB of free cloud storage.

----------------------------------
Visit our ExcelVBA group home page for more info and support files:
http://groups.yahoo.com/group/ExcelVBA
------------------------------------

Visit Your Group