[Resolvido]Ajuda com Código para Scanner

Boa tarde,

Tenho um código que funciona muito bem para digitalizar um JPG. Código este adaptado de um post deste forum.
Este código abaixo me permite escolher onde o arquivo será salvo e depois copia o link em um campo no formulário ( fiz isso para que o Banco de dados não fique pesado).
Bom, o que eu preciso é digitalizar várias paginas e salvar em pdf o arquivo final.
Então por exemplo: Voce digitaliza a primeira pagina e em seguida vem uma mensagem perguntando se voce quer digitalizar mais alguma e assim vai até o usuário clicar em Não ( no caso quando já tiver digitalizado tudo o que precisava ). Neste momento as paginas são formatadas para PDF.

Meu código é esse:

________________________________________________________________________________________
Public Sub ObterImagem()

Dim LocalArquivo As String
Dim NomeArquivo As FileDialog
Set NomeArquivo = Application.FileDialog(msoFileDialogSaveAs)

On Error Resume Next
NomeArquivo.Title = "Salve o Arquivo como..."
NomeArquivo.InitialFileName = "Meu caminho na Rede onde salvo os arquivos"
NomeArquivo.InitialFileName = ""



If NomeArquivo.Show Then

   LocalArquivo = NomeArquivo.SelectedItems(1) & ".jpg"
   strSalvarScanner = LocalArquivo
   
   Dim scan As Object
   Dim imagem As Object
   
   
   Set scan = CreateObject("WIA.CommonDialog")
   Set imagem = CreateObject("WIA.ImageFile")
   
   
   
   Set imagem = scan.ShowAcquireImage()
   imagem.SaveFile LocalArquivo
       

End If

End Sub


Tem um código que achei na internet que parece o caminho, mas não estou conseguindo adaptar. Assim abaixo passarei o código que eu estou estudando e peço que alguem me ajude a chegar no resultado que mencionei acima.

____________________________________________________________________________________________________________
'Requirements:
'Must include reference to Microsoft Windows Image Acquisition 2.0 dll
'Create a table named scantemp. Create ID column as Autonumber. Create 2nd column named Picture with Text as datatype.
'Create a continuous report named rptscan. Set scantemp table as recordsource. Add image control to report and set Picture
'as the control source. Make the image control the size of an 8.5 x 11 sheet so that the whole document appears normally when the
'create textbox set name txt_id for enter PDF files name
'report is exported to pdf.
'For use with a scanner that continually scans documents until the ADF tray is empty unlimit pages.

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

__________________________________________________________________________________________________________________

Quem puder me ajudar nisso e quiser falar comigo podemos conversar via skype ou algo assim ou até por aqui mesmo.
Creio que ao conseguir finalizar este código estaremos ajudando muitas pessoas neste forum por se tratar de um código bem interessante.
Fico no aguardo e desde já agradeço.

Att,

Bom dia,

Apenas lendo o código que postou me parece que está funcionando normalmente como funciona uma digitalização no software da impressora. Neste caso em específico o usuário coloca lá as folhas e ela vai escaneando e salvando em uma pasta temporária cada pagina como imagem ao mesmo tempo que salva o caminho cada uma na tabela. Baseado nessa tabela há um relatório. Depois de todas as paginas serem geradas, o código abre o relatório (que automaticamente será populado com todas as fotos escaneadas anteriormente, cujo endereço está na tabela) e então o imprime em pdf. Depois exclui as fotos da pasta temporária e tal. Ok, tudo funcionando corretamente.

No caso de você querer perguntar ao usuário se ele quer escanear mais folhas além daquelas que colocou na impressora, uma alternativa seria colocar um variável booleana e fazer a pergunta enquanto ela for verdadeira. Algo assim:

Código:

Dim booPergunta as boolean

booPergunta = true

do while booPergunta = true
    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

    If Msgbox("Deseja escanear mais folhas?", vbQuestion + vbYesNo, "Scanner") = vbNo Then
        booPergunta = false
    end if
loop


Se não for exatamente isso nos dê um norte mais preciso por favor. Se possível poste um modelo para que possamos nos interar mais a fundo.

Abraço.

Bom dia Cassio,

O que quero na verdade é usar o código de exemplo ( que gera um relatorio ) e adaptar no primeiro código que eu já tenho.
Não quero que crie relatorio, eu quero que o arquivo PDF com as paginas selecionadas seja salvo aonde eu indiquei no meu código.
No caso não estou conseguindo adaptar o código 2 ao código 1.
Voce pode me ajudar nisso ?

Por exemplo:

O primeiro código funciona bem e ele faz exatamente isso:

Ele me pergunta aonde quero salvar o arquivo
Me pede para informar o nome do arquivo
Abre o Twain do Scanner que tenho ativo no PC
Digitaliza e salva.


Preciso de um código que faça tudo acima e mais:

Após digitalizar a primeira pagina ele pergunta se quero digitalizar mais uma pagina.
Quando eu não quizer mais digitalizar ele pega todas as imagens, converte em PDF e salva no local que eu determinei e com o nome que eu digitei.

Basicamente é isso, postei o segundo código como exemplo, por que ele faz mais ou menos isso.
Porém não estou conseguindo adaptar, isso será a cereja do bolo do sistema que criei aqui para empresa. Por isso peço sua ajuda.

Se puder me ajudar nisso eu agradeço.

Att,

Boa tarde,

Adaptei seu codigo com a ideia do segundo. Acredito que resolverá o seu problema.

Salvei as imagens em código sequencial numa pasta temporária que é criada no começo da interação e excluída quando o usuário não quiser mais escanear nenhum arquivo. Deixei que a cada nova imagem o usuário possa escolher a impressora para o caso de querer escanear arquivos de uma diferente em determinado momento. Qualquer duvida estou à disposição.

Abraço.

Bom dia Cassio, tudo bem ?

Então, o código não esta funcionando.
Ele faz tudo, solicita o nome do arquivo e tal e vem a Mensagem ( Deseja cancelar apenas esta imagem?)
Só que se eu clico em Sim ele Digitaliza e faz novamente a mesma pergunta.
Tentei mexer mas não entendi nada kkkkkkkkkkkk
Outra coisa, entendi que vc digitaliza as paginas e tal e os arquivos temporários são salvos LocalArquivo.
No caso pelo que entendi no código as paginas são inseridas pelo contador e no final são todas anexadas ao relatório para que seja convertida em PDF certo ? mas o arquivo que salvei por exemplo em Meus Documentos, será o arquivo em PDF ???



Public Sub ObterImagem()
On Error Resume Next

MkDir CurrentProject.Path & "\temp"
CurrentDb.Execute "DELETE * from tblImprimir"

Dim booPergunta, booContinue As Boolean
Dim contador As Integer
Dim localArquivo As String
Dim nomeArquivo

Set nomeArquivo = Application.FileDialog(msoFileDialogSaveAs)

booPergunta = True
booContinue = True
contador = 1

nomeArquivo.Title = "Salve o Arquivo como..."
nomeArquivo.InitialFileName = "Meu caminho na Rede onde salvo os arquivos"
nomeArquivo.InitialFileName = ""

If nomeArquivo.Show Then
Do While Not booPergunta = False
Dim scan As Object
Dim imagem As Object

Set scan = CreateObject("WIA.CommonDialog")
Set imagem = CreateObject("WIA.ImageFile")
Set imagem = scan.ShowAcquireImage()

If scan.Cancel Then
If MsgBox("Deseja cancelar apenas esta imagem? (Clicando em 'não' todo o processo será cancelado)", vbQuestion + vbYesNo, "Cancelar") = vbNo Then
Exit Sub
Else
booContinue = False
End If
End If

If booContinue = True Then
localArquivo = CurrentProject.Path & "\temp\" & contador & ".jpg"
strSalvarScanner = localArquivo
imagem.SaveFile localArquivo

Dim rs As Recordset

Set rs = CurrentDb.OpenRecordset("tblImprimir")
rs.AddNew
rs("caminho") = localArquivo
rs.Update

If MsgBox("Deseja escanear outra imagem?", vbQuestion + vbYesNo, "Scanner") = vbNo Then
booPergunta = False
Else
contador = contador + 1
End If
End If

booContinue = True
Loop

If rs.RecordCount > 0 Then
DoCmd.OpenReport "rptImprimir", acViewPreview, , , acHidden
DoCmd.OutputTo acOutputReport, "rptImprimir", acFormatPDF, nomeArquivo.SelectedItems(1) & ".pdf"
DoCmd.Close acReport, "rptImprimir"

MsgBox "Arquivo salvo com sucesso!", vbInformation, "Arquivo"
End If

Kill (CurrentProject.Path & "\temp\*.*")
RmDir (CurrentProject.Path & "\temp")
End If
End Sub

Bom dia,

Baixe o exemplo que repostei na mensagem anterior e tente novamente.

Sim, o arquivo salvo na pasta que voce escolher é o arquivo PDF.

Abraço.

Boa tarde,

Dediquei um tempinho hoje para dar fim no seu problema. Fiz algumas modificações na função para fazer aquela ideia de o usuário poder cancelar em algum momento o escaneamento da foto, mas ter a opção de continuar fazendo em seguinda.

Código:

Public Sub ObterImagem()
    On Error Resume Next
    
    MkDir CurrentProject.Path & "\temp"
    CurrentDb.Execute "DELETE * from tblImprimir"
    
    Dim booPergunta, booContinue As Boolean
    Dim contador As Integer
    Dim localArquivo As String
    Dim nomeArquivo

    Set nomeArquivo = Application.FileDialog(msoFileDialogSaveAs)
    
    booPergunta = True
    booContinue = True
    contador = 1
    
    nomeArquivo.Title = "Salve o Arquivo como..."
    nomeArquivo.InitialFileName = "Meu caminho na Rede onde salvo os arquivos"
    nomeArquivo.InitialFileName = ""

    If nomeArquivo.Show Then
        Do While Not booPergunta = False
            Dim scan As New WIA.CommonDialog
            Dim imagem As WIA.ImageFile
            
            Set imagem = scan.ShowAcquireImage()
            
            If imagem.Properties.Exists(False) Then
                If MsgBox("Deseja cancelar apenas esta imagem? (Clicando em 'não' todo o processo será cancelado)", vbQuestion + vbYesNo, "Cancelar") = vbNo Then
                    Exit Sub
                Else
                    booContinue = False
                End If
            End If
            
            If booContinue = True Then
                localArquivo = CurrentProject.Path & "\temp\" & contador & ".jpg"
                strSalvarScanner = localArquivo
                imagem.SaveFile localArquivo
                
                Dim rs As Recordset
                
                Set rs = CurrentDb.OpenRecordset("tblImprimir")
                rs.AddNew
                    rs("caminho") = localArquivo
                rs.Update
                
                If MsgBox("Deseja escanear outra imagem?", vbQuestion + vbYesNo, "Scanner") = vbNo Then
                    booPergunta = False
                Else
                    contador = contador + 1
                End If
            End If
            
            booContinue = True
        Loop
        
        If rs.RecordCount > 0 Then
            DoCmd.OpenReport "rptImprimir", acViewPreview, , , acHidden
            DoCmd.OutputTo acOutputReport, "rptImprimir", acFormatPDF, nomeArquivo.SelectedItems(1) & ".pdf"
            DoCmd.Close acReport, "rptImprimir"
            
            MsgBox "Arquivo salvo com sucesso!", vbInformation, "Arquivo"
        End If
        
        Kill (CurrentProject.Path & "\temp\*.*")
        RmDir (CurrentProject.Path & "\temp")
    End If
End Sub

O funcionamento do código é o seguinte:
-> Clique do botão
-> criação de uma pasta temporária "temp" na raiz de onde o db está
-> Seleção do local e nome do arquivo a ser salvo (apenas isso, não é gerado ainda) e salva o caminho e nome do arquivo na variável nomeArquivo.SelectedItems(1)
-> Seleção do scanner a ser utilizado
-> Sistema faz o scanner e salva a imagem na pasta "temp" em código sequencial (a primeira imagem escaneada é a numero 1, a segunda o 2, etc) ao mesmo tempo que salva o caminho na tblImprimir
-> Se o usuário cancelar o processo tudo é feita uma pergunta na msgbox podendo resultar em cancelamento do processo todo ou apenas da foto atual
-> Após todas as imagens serem escaneadas, o sistema abre o relatório rptImprimir (que está acoplado à tblImprimir) em modo oculto e o imprime em pdf no caminho da variável nomeArquivo.SelectedItems(1)
-> Depois disso o sistema exclui todos os arquivos e a pasta temporária.
-> Arquivo salvo com nome e no local selecionados.

Acredito que com isso não tenha maiores problemas para adaptação.

Abraço.

Bom dia Cassio,

Cara ficou excelente, vou adaptar ao meu BD pois o caminho do arquivo eu salvo em uma txt para que o BD não fique grande mas ficou excelente mesmo. Obrigado.

Estarei adaptando e compartilharei aqui mesmo como ficou meu código assim que o terminar ok.
Vou tentar explicar cada linha do código com comentários, assim outros poderão entender o que vc fez e a minha adaptação ok.
Se quizer me ajudar nisso também vai ser legal.

Valei mesmo e um abraço, só não finalizarei o tópico pois como prometido irei colocar meu código aqui blz.

Abraço

Boa tarde,

Qualquer coisa estou à disposição. Aguardamos o retorno.

Abraço.

Boa noite Cassio, tudo bem ?

Cara, cá estou eu tentando adaptar o código a minha necessidade.
Vou te explicar resumidamente o que estou fazendo.
Eu trabalho em uma clinica de Medicina Ocupacional.
Dito isso lá se tem o ASO ( Atestado de Saude Ocupacional ) e o Prontuário clinica com seus respectivos exames se houver.
No meu sistema o que faço:

Veja que no primeiro código que postei, ele salva a imagem em JPG mesmo e tal.
Por que ele esta salvando o ASO, isso foi feito por que quando o ASO esta Apto eu encaminho o ASO via e-mail para a empresa.
Então para não sobrecarregar o sistema e salvar as imagens no Banco, as imagens são salvas na rede e tem um campo Texto no formulário
que ao digitalizar ele salva o caminho do arquivo na rede conforme abaixo em negrito:
________________________________________
Public Sub ObterImagem()

Dim LocalArquivo As String
Dim NomeArquivo As FileDialog
Set NomeArquivo = Application.FileDialog(msoFileDialogSaveAs)

On Error Resume Next
NomeArquivo.Title = "Salve o Arquivo como..."
NomeArquivo.InitialFileName = "Meu caminho na Rede onde salvo os arquivos"
NomeArquivo.InitialFileName = ""



If NomeArquivo.Show Then

LocalArquivo = NomeArquivo.SelectedItems(1) & ".jpg"
strSalvarScanner = LocalArquivo

Dim scan As Object
Dim imagem As Object


Set scan = CreateObject("WIA.CommonDialog")
Set imagem = CreateObject("WIA.ImageFile")



Set imagem = scan.ShowAcquireImage()
imagem.SaveFile LocalArquivo


End If

End Sub
___________________________________________

No código que voce fez a variável Local Arquivo, esta com a função de guardar as imagens digitalizadas para depois serem salvas.
Veja que no meu código acima o LocalArquivo esta assim ( LocalArquivo = NomeArquivo.SelectedItems(1) & ".jpg" )
Quando vou chamar o código no meu sistema que funciona ele fica assim:

Private Sub ScanASO()

Call Obterimagem
me.txtASO = LocalArquivo

End Sub

Isso faz com que eu digitalize e ao final o endereço do arquivo seja salvo no campo txt. Isso eu faço pq quando fiz o código para enviar E-mail
Ele puxa o anexo deste campo. Ficou bem legal e funcional.
Agora. Não quero fazer o mesmo com o prontuario. O prontuario foi o motivo pelo qual pedi sua ajuda, pois são muitas paginas e precisariam ficar em PDF. Porém existe um campo de Texto que também fica gravado o endereço do arquivo para que o mesmo seja visualizado em um Webbrowser caso algum Médico precise verificar um atendimento anterior.
Em resumo:
Criei uma variável publica chamada Destino ( Public Destino as String ) e coloquei no seu código, o arquivo fica em branco. Pode me ajudar nisso ?
Segue o código :


Public Sub ObterImagem()
   On Error Resume Next
   
   MkDir CurrentProject.Path & "\temp"
   CurrentDb.Execute "DELETE * from tblImprimir"
   
   Dim booPergunta, booContinue As Boolean
   Dim contador As Integer
   Dim localArquivo As String
   Dim nomeArquivo
   Dim Destino as String

   Set nomeArquivo = Application.FileDialog(msoFileDialogSaveAs)
   
   booPergunta = True
   booContinue = True
   contador = 1
   
   nomeArquivo.Title = "Salve o Arquivo como..."
   nomeArquivo.InitialFileName = "Meu caminho na Rede onde salvo os arquivos"
   nomeArquivo.InitialFileName = ""

   If nomeArquivo.Show Then
       Do While Not booPergunta = False
           Dim scan As New WIA.CommonDialog
           Dim imagem As WIA.ImageFile
           
           Set imagem = scan.ShowAcquireImage()
           
           If imagem.Properties.Exists(False) Then
               If MsgBox("Deseja cancelar apenas esta imagem? (Clicando em 'não' todo o processo será cancelado)", vbQuestion + vbYesNo, "Cancelar") = vbNo Then
                   Exit Sub
               Else
                   booContinue = False
               End If
           End If
           
           If booContinue = True Then
               localArquivo = CurrentProject.Path & "\temp\" & contador & ".jpg"
               strSalvarScanner = localArquivo
               imagem.SaveFile localArquivo
               
               Dim rs As Recordset
               
               Set rs = CurrentDb.OpenRecordset("tblImprimir")
               rs.AddNew
                   rs("caminho") = localArquivo
               rs.Update
               
               If MsgBox("Deseja escanear outra imagem?", vbQuestion + vbYesNo, "Scanner") = vbNo Then
                   booPergunta = False
               Else
                   contador = contador + 1
               End If
           End If
           
           booContinue = True
       Loop
       
       If rs.RecordCount > 0 Then
           DoCmd.OpenReport "rptImprimir", acViewPreview, , , acHidden
           DoCmd.OutputTo acOutputReport, "rptImprimir", acFormatPDF, nomeArquivo.SelectedItems(1) & ".pdf"
           DoCmd.Close acReport, "rptImprimir"
          Destino  = nomeArquivo.SetectedItems(1) & ".pdf"
           
           MsgBox "Arquivo salvo com sucesso!", vbInformation, "Arquivo"
       End If
       
       Kill (CurrentProject.Path & "\temp\*.*")
       RmDir (CurrentProject.Path & "\temp")
   End If
End Sub


________________________________

Private Sub ScanProntuario()

Call Obterimagem
me.txtProntuario = Destino

End Sub

Boa noite,

seu problema acontece porque voce criou a variavel destino dentro da função ObterImagem. Quando você quer criar uma variável que será acessada por todos os controles do formulário em tempo de execução, voce deve criá-la de modo "publico" no formulário, ou seja, no topo do código, logo abaixo do Option. Analogamente, se voce quisesse criar uma variável que fosse ser acessada por todos os formulário/consultas/relatórios/etc, voce deve criá-la em um módulo global. Do jeito que voce fez aí, ela só pode ser acessada dentro da função ObterImagem, quando a função termina a execução, a variável "deixa de existir".

Voce pode fazer duas coisas:
Criar a variável logo abaixo do option:

Código:

Option Compare Database

Dim destino as string

Ou, preencher o campo dentro da função (neste caso não precisaria nem de uma nova variável):

Código:

 ...
DoCmd.OpenReport "rptImprimir", acViewPreview, , , acHidden
DoCmd.OutputTo acOutputReport, "rptImprimir", acFormatPDF, nomeArquivo.SelectedItems(1) & ".pdf"
DoCmd.Close acReport, "rptImprimir"
txtProntuario = nomeArquivo.SetectedItems(1) & ".pdf"

Veja o que te atende melhor.

Abraço.

Boa tarde Cassio,

Fiz do jeito fácil e não deu também ( me.txtDestino = nomeArquivo.SelectedItems(1) & ".pdf" ) e não pega também.
Não esta salvando de jeito nenhum, será que estou fazendo algo errado ? Veja o código:

Option Compare Database
Dim destino As String



Private Sub btn_Click()
On Error Resume Next

MkDir CurrentProject.Path & "\temp"
CurrentDb.Execute "DELETE * from tblImprimir"

Dim booPergunta, booContinue As Boolean
Dim contador As Integer
Dim localArquivo As String
Dim nomeArquivo

Set nomeArquivo = Application.FileDialog(msoFileDialogSaveAs)

booPergunta = True
booContinue = True
contador = 1

nomeArquivo.Title = "Salve o Arquivo como..."
nomeArquivo.InitialFileName = "Meu caminho na Rede onde salvo os arquivos"
nomeArquivo.InitialFileName = ""

If nomeArquivo.Show Then
Do While Not booPergunta = False
Dim scan As New WIA.CommonDialog
Dim imagem As WIA.ImageFile

Set imagem = scan.ShowAcquireImage()

If imagem.Properties.Exists(False) Then
If MsgBox("Deseja cancelar apenas esta imagem? (Clicando em 'não' todo o processo será cancelado)", vbQuestion + vbYesNo, "Cancelar") = vbNo Then
Exit Sub
Else
booContinue = False
End If
End If

If booContinue = True Then
localArquivo = CurrentProject.Path & "\temp\" & contador & ".jpg"
strSalvarScanner = localArquivo
imagem.SaveFile localArquivo

Dim rs As Recordset

Set rs = CurrentDb.OpenRecordset("tblImprimir")
rs.AddNew
rs("caminho") = localArquivo
rs.Update

If MsgBox("Deseja escanear outra imagem?", vbQuestion + vbYesNo, "Scanner") = vbNo Then
booPergunta = False
destino = nomeArquivo.SelectedItems(a) & ".pdf"

Else
contador = contador + 1
End If
End If

booContinue = True
Loop

If rs.RecordCount > 0 Then

DoCmd.OpenReport "rptImprimir", acViewPreview, , , acHidden
DoCmd.OutputTo acOutputReport, "rptImprimir", acFormatPDF, nomeArquivo.SelectedItems(1) & ".pdf"
DoCmd.Close acReport, "rptImprimir"
Me.txtDestino = destino
MsgBox "Arquivo salvo com sucesso!", vbInformation, "Arquivo"
End If

Kill (CurrentProject.Path & "\temp\*.*")
RmDir (CurrentProject.Path & "\temp")
destino = ""
End If


End Sub

Boa noite,

Tente trocar o (a) por (1) no trecho abaixo:

Código:

If MsgBox("Deseja escanear outra imagem?", vbQuestion + vbYesNo, "Scanner") = vbNo Then
booPergunta = False
destino = nomeArquivo.SelectedItems(a) & ".pdf"


Eu recomendo a extinção da variável destino, pois está ocupando espaço na memória para armezar um dado que pode ser colocado direto no campo.

Abraço.

Bom dia Cassio,

Removi a variavel Destino e coloquei ( me.txtProntuario = nomeArquivo.SelectedItems(a) & ".pdf" ) conforme orientação e mesmo assim não da certo.
O Arquivo fica em branco e não preenche o campo txtProntuario
O arquivo esta saindo todo em branco quando mexo no seu código.
Andei pensando aqui, se eu mexer só um pouco no seu código.
Ao inves de solicitar que o usuario selecione aonde vai salvar e o nome, eu modifico para um nome fixo e que seja salvo em um local especifico também. Como cada Prontuario vem de um atendimento especifico. Posso salvar o arquivo com o Código do Atendimento e já informar o local na rede já que o numero nunca se repetira. Assim, ao clicar no botão digitalizar já será preenchido o campo txtProntuario com o caminho. O que acha ?

Boa tarde Cassio,


Problema solucionado.

Conforme falei acima o Arquivo esta sendo salvo na mesma pasta e com o código do Atendimento.
Assim antes de iniciar o processo o campo txtProntuário já é preenchido desta forma:

Me.txtProntuario = "Meu local na Rede" & CódigoAtendimento & ".pdf"

Assim o que conter no código ( nomeArquivo.SelectedItems(a) & ".pdf" ) será o mesmo que foi salvo resolvendo meu problema em definitivo.

Agradeço por sua ajuda Cassio e espero que este código ajude muitas pessoas.

Voce acha legal postarmos o código completo aqui ?

Bom tarde,

Fico feliz que tenhamos conseguido solucionar isso.

Acho de extrema importancia colocar o código completo aqui e um modelo no repositório. Eu colocarei o modelo que postei acima lá e linkarei este tópico para quem quiser fazer as alterações que você fez.

Abraço.

Ok.

Espero que o código abaixo ajude a todos que queiram Digitalizar em PDF no Access ok.

Segue Código completo:


Antes de tudo deve-se criar a tabela "tblImprimir" e o relatório "rptImprimir".
Na tabela "tblImprimir" deve-se criar um campo chamado "caminho" do tipo "Texto".
A fonte de dados do "rptImprimir" é a "tblImprimir"
Os comentários entre parenteses são as explicações sobre o que o código faz ok.


Private Sub btn_Click()
On Error Resume Next

'(Cria a pasta "temp" uma pasta temporária para salvar as imagens )

MkDir CurrentProject.Path & "\temp"

'( Deleta tudo o que conter na tabela "tblImiprimir")

CurrentDb.Execute "DELETE * from tblImprimir"

'(criando as variáveis)

Dim booPergunta, booContinue As Boolean
Dim contador As Integer
Dim localArquivo As String
Dim nomeArquivo

'( Setando a variável "nomeArquivo" a um objeto Openfiledialog )

Set nomeArquivo = Application.FileDialog(msoFileDialogSaveAs)

'( Setando as Variáveis "booPergunta" e "booContinue" para True = Verdadeiro e iniciando a contagem da variável "contador" )

booPergunta = True
booContinue = True
contador = 1

'( Indicando o Local onde será salvo o arquivo e o nome do arquivo )

nomeArquivo.Title = "Salve o Arquivo como..."
nomeArquivo.InitialFileName = "Meu caminho na Rede onde salvo os arquivos"
nomeArquivo.InitialFileName = ""

'( depois de salvar será iniciado O Scanner )

If nomeArquivo.Show Then
Do While Not booPergunta = False
Dim scan As New WIA.CommonDialog
Dim imagem As WIA.ImageFile

Set imagem = scan.ShowAcquireImage()

'( Caso o Scanner esteja desligado ou não tenha documento na bandeja, o sistema perguntará se deseja cancelar )

If imagem.Properties.Exists(False) Then
If MsgBox("Deseja cancelar apenas esta imagem? (Clicando em 'não' todo o processo será cancelado)", vbQuestion + vbYesNo, "Cancelar") = vbNo Then
Exit Sub
Else
booContinue = False
End If
End If

'( Continuando, salvará a imagem na pasta "temp" e o caminho na tabela "tblImprimir )

If booContinue = True Then
localArquivo = CurrentProject.Path & "\temp\" & contador & ".jpg"
strSalvarScanner = localArquivo
imagem.SaveFile localArquivo

Dim rs As Recordset

Set rs = CurrentDb.OpenRecordset("tblImprimir")
rs.AddNew
rs("caminho") = localArquivo
rs.Update

'( aqui o sistema pergunta se quer inserir uma nova imagem, clicando em sim o processo acima é refeito, em não inicia o processo de conversão e salvamento )

If MsgBox("Deseja escanear outra imagem?", vbQuestion + vbYesNo, "Scanner") = vbNo Then
booPergunta = False


Else
contador = contador + 1
End If
End If

booContinue = True
Loop

'( aqui é o processo de conversão e salvamento, onse se abre o relatório "rptImprimir" )
'( depois salva o relatório no local que vc escolheu e com o nome que voce escolheu )
'( depois o relatório é fechado )
'( por ultimo aparece uma mensagem mencionando que o processo foi efetuado com sucesso )

If rs.RecordCount > 0 Then

DoCmd.OpenReport "rptImprimir", acViewPreview, , , acHidden
DoCmd.OutputTo acOutputReport, "rptImprimir", acFormatPDF, nomeArquivo.SelectedItems(1) & ".pdf"
DoCmd.Close acReport, "rptImprimir"

MsgBox "Arquivo salvo com sucesso!", vbInformation, "Arquivo"

End If

'(por fim, apaga a pasta temporária "temp")

Kill (CurrentProject.Path & "\temp\*.*")
RmDir (CurrentProject.Path & "\temp")

End If


End Sub

Cassio,

Ficou com assim ?

Boa tarde,

Muito bom. Valeu.

Abraço.

Resolvido !!!

amigos estou reabrindo o topico pois nao consegui utilizar este exemplo, ja tem um tempo que estou batendo cabeça em cima, sempre aparece a mensagem de erro conforme imagem em anexo:

Erro: Erro em tempo de execução '-2145320939(80210015)':
Nenhum dispotivo WIA do tipo selecionado está disponível.

Linha do comando do erro:  Set imagem = scan.ShowAcquireImage()

Utilizo o Access 2003
Windows 7
Meu scanner é uma multifuncional epson 6191 que esta em rede


Desde ja agradeco

abraços