MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    [Resolvido]Ajuda com Código para Scanner

    Compartilhe
    avatar
    rpfspawn
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 50
    Registrado : 07/09/2016

    [Resolvido]Ajuda com Código para Scanner

    Mensagem  rpfspawn em Seg 01 Maio 2017, 17:31

    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,


    Última edição por rpfspawn em Seg 08 Maio 2017, 20:12, editado 1 vez(es)
    avatar
    CassioFabre
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 433
    Registrado : 18/01/2013

    Re: [Resolvido]Ajuda com Código para Scanner

    Mensagem  CassioFabre em Ter 02 Maio 2017, 13:37

    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.
    avatar
    rpfspawn
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 50
    Registrado : 07/09/2016

    Re: [Resolvido]Ajuda com Código para Scanner

    Mensagem  rpfspawn em Ter 02 Maio 2017, 14:49

    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,
    avatar
    CassioFabre
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 433
    Registrado : 18/01/2013

    Re: [Resolvido]Ajuda com Código para Scanner

    Mensagem  CassioFabre em Ter 02 Maio 2017, 19:44

    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.
    avatar
    rpfspawn
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 50
    Registrado : 07/09/2016

    Re: [Resolvido]Ajuda com Código para Scanner

    Mensagem  rpfspawn em Qua 03 Maio 2017, 14:16

    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


    avatar
    CassioFabre
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 433
    Registrado : 18/01/2013

    Re: [Resolvido]Ajuda com Código para Scanner

    Mensagem  CassioFabre em Qua 03 Maio 2017, 14:28

    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.
    avatar
    CassioFabre
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 433
    Registrado : 18/01/2013

    Re: [Resolvido]Ajuda com Código para Scanner

    Mensagem  CassioFabre em Qua 03 Maio 2017, 20:46

    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.
    Anexos
    scanner com cancel.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (198 Kb) Baixado 19 vez(es)
    avatar
    rpfspawn
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 50
    Registrado : 07/09/2016

    Re: [Resolvido]Ajuda com Código para Scanner

    Mensagem  rpfspawn em Qui 04 Maio 2017, 13:07

    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
    avatar
    CassioFabre
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 433
    Registrado : 18/01/2013

    Re: [Resolvido]Ajuda com Código para Scanner

    Mensagem  CassioFabre em Qui 04 Maio 2017, 20:04

    Boa tarde,

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

    Abraço.
    avatar
    rpfspawn
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 50
    Registrado : 07/09/2016

    Re: [Resolvido]Ajuda com Código para Scanner

    Mensagem  rpfspawn em Sex 05 Maio 2017, 22:24

    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
    avatar
    CassioFabre
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 433
    Registrado : 18/01/2013

    Re: [Resolvido]Ajuda com Código para Scanner

    Mensagem  CassioFabre em Sab 06 Maio 2017, 03:04

    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.
    avatar
    rpfspawn
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 50
    Registrado : 07/09/2016

    Re: [Resolvido]Ajuda com Código para Scanner

    Mensagem  rpfspawn em Sab 06 Maio 2017, 17:27

    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
    avatar
    CassioFabre
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 433
    Registrado : 18/01/2013

    Re: [Resolvido]Ajuda com Código para Scanner

    Mensagem  CassioFabre em Dom 07 Maio 2017, 03:48

    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.
    avatar
    rpfspawn
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 50
    Registrado : 07/09/2016

    Re: [Resolvido]Ajuda com Código para Scanner

    Mensagem  rpfspawn em Seg 08 Maio 2017, 14:30

    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 ?

    avatar
    rpfspawn
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 50
    Registrado : 07/09/2016

    Re: [Resolvido]Ajuda com Código para Scanner

    Mensagem  rpfspawn em Seg 08 Maio 2017, 16:08

    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 ?
    avatar
    CassioFabre
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 433
    Registrado : 18/01/2013

    Re: [Resolvido]Ajuda com Código para Scanner

    Mensagem  CassioFabre em Seg 08 Maio 2017, 17:29

    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.
    avatar
    rpfspawn
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 50
    Registrado : 07/09/2016

    Re: [Resolvido]Ajuda com Código para Scanner

    Mensagem  rpfspawn em Seg 08 Maio 2017, 18:05

    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


    Última edição por rpfspawn em Seg 08 Maio 2017, 20:11, editado 1 vez(es)
    avatar
    rpfspawn
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 50
    Registrado : 07/09/2016

    Re: [Resolvido]Ajuda com Código para Scanner

    Mensagem  rpfspawn em Seg 08 Maio 2017, 18:07

    Cassio,

    Ficou com assim ?
    avatar
    CassioFabre
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 433
    Registrado : 18/01/2013

    Re: [Resolvido]Ajuda com Código para Scanner

    Mensagem  CassioFabre em Seg 08 Maio 2017, 19:30

    Boa tarde,

    Muito bom. Valeu.

    Abraço.
    avatar
    rpfspawn
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 50
    Registrado : 07/09/2016

    Re: [Resolvido]Ajuda com Código para Scanner

    Mensagem  rpfspawn em Seg 08 Maio 2017, 20:11

    Resolvido !!!

      Data/hora atual: Ter 19 Set 2017, 12:49