PDF PARA TEXTBOX

  

Public Function ConsultarPDF(cCliente As clsCliente, bCompleto As Boolean, Optional pProgressBar As ProgressBar, Optional lLabelPaginaProgresso As Label) As Boolean
    
    Dim strEmail                        As String
    Dim blnPaginaMudou                  As Boolean
    
    Dim clsParte                        As clsParte
    Dim colClienteParte                 As New colClienteParte
    
    Dim strNome_Procura                 As String
    Dim iVarFor                         As Integer
    Dim iVarForAux                      As Long
    Dim strNomeAnterior                 As String
    
    On Error GoTo TrataErro
    
    Screen.MousePointer = vbHourglass
    
    Set acrApp = CreateObject("AcroExch.App")
    acrApp.CloseAllDocs
    
    Set acrDoc = CreateObject("AcroExch.AVDoc")
    Set acrPDDoc = CreateObject("AcroExch.PDDoc")
    Set colPagina = New colImportacaoPagina
    
    acrPDDoc.Close
    
    acrDoc.Open strArquivoPDF, ""
    Set acrPDDoc = acrDoc.GetPDDoc
    
    strDocumento = UCase(acrPDDoc.GetFileName)
    strDiario = DescricaoDiario(acrPDDoc.GetFileName)
    strSecao = DescricaoSecao(acrPDDoc.GetFileName)
    
    lngTotalPublicacoes = 0
    
    colClienteParte.Clear
    
    If Not pProgressBar Is Nothing Then
        pProgressBar.Value = 0
        pProgressBar.Max = acrPDDoc.GetNumPages
    End If
    
    'Colocado somente para zerar a procura do PDF
    Call acrDoc.FindText("", 0, 0, 1)
    
    If colClienteParte.Filtrar(cCliente.Codigo) Then
        For iVarFor = 1 To colClienteParte.Count
            pProgressBar.Value = 0
            If Not lLabelPaginaProgresso Is Nothing Then
                lLabelPaginaProgresso.Visible = True
                lLabelPaginaProgresso.Caption = "0 de " & acrPDDoc.GetNumPages '& " Parte: " & clsParte.Descricao
            End If
            DoEvents
            strNome_Procura = ": " & colClienteParte(iVarFor).NomeParte & " "
            frmImportacao.lblParte = colClienteParte(iVarFor).NomeParte
            DoEvents
            clsPaginaAnt.Pagina = 0
            Do
                'Verifica existência de publicação
                If acrDoc.FindText(strNome_Procura, 0, 0, 0) Then
                    Set acrPageView = acrDoc.GetAVPageView
                    Set acrPage = acrPageView.GetPage
                    If Not lLabelPaginaProgresso Is Nothing Then
                        lLabelPaginaProgresso.Caption = (acrPage.GetNumber + 1) & " de " & acrPDDoc.GetNumPages '& " Parte: " & clsParte.Descricao
                        DoEvents
                    End If
                    If Not pProgressBar Is Nothing Then
                        pProgressBar.Value = acrPage.GetNumber + 1
                        DoEvents
                    End If
                    If Not clsPaginaAnt.Pagina = (acrPage.GetNumber + 1) Then
                        'Caso a página atual seja inferior a anterior, força saida de loop
                        If acrPage.GetNumber < clsPaginaAnt.Pagina Then
                            GoTo Novamente
                        End If
                        
                        Set clsPagina = New clsImportacaoPagina                     'Inicializa uma nova Página e uma nova Publicação
                        Set clsPublicacao = New clsImportacaoPublicacao
                        
                        clsPagina.Pagina = acrPage.GetNumber + 1
                        clsPagina.NomeProcura = strNome_Procura
                        
                        If bCompleto = True Then
                            PegaDadosCompletos cCliente, clsPagina.Pagina
                        Else
                            clsPagina.Publicacao.Add clsPublicacao                  'Adiciona a nova Publicação a nova Página
                        End If
                        
                        colPagina.Add clsPagina                                     'Adiciona a nova Página a coleção
                        
                        'Guarda relação de páginas encontradas efetuando quebra de linha
                        'a cada 10 páginas encontradas
                        If strNomeAnterior <> colClienteParte(iVarFor).NomeParte Then
                            strPaginas = strPaginas & vbCrLf & vbCrLf & "Páginas encontradas para " & colClienteParte(iVarFor).NomeParte & vbCrLf & " " & clsPagina.Pagina
                        ElseIf strPaginas = "" Then
                            strPaginas = "Páginas encontradas para " & colClienteParte(iVarFor).NomeParte & vbCrLf & " " & clsPagina.Pagina
                            lngCont = 1
                        Else
                            If lngCont = 10 Then
                                strPaginas = strPaginas & vbCrLf & clsPagina.Pagina
                                lngCont = 1
                            Else
                                strPaginas = strPaginas & "; " & clsPagina.Pagina
                                lngCont = lngCont + 1
                            End If
                        End If
                        Set clsPaginaAnt = clsPagina                                'Seta a página atual como anterior
'                        Debug.Print strPaginas
                    Else
                        If bCompleto = False Then
                            Set clsPublicacao = New clsImportacaoPublicacao
                            clsPublicacao.Titulo = ""
                            clsPublicacao.Origem = ""
                            clsPublicacao.Conteudo = ""
                            clsPagina.Publicacao.Add clsPublicacao
                        End If
                    End If
                Else
                    GoTo Novamente
                End If
                
                lngTotalPublicacoes = lngTotalPublicacoes + 1
    
                strNomeAnterior = colClienteParte(iVarFor).NomeParte
                
            Loop
            
Novamente:
            Call acrDoc.FindText(" ", 0, 0, 1)
            strNomeAnterior = colClienteParte(iVarFor).NomeParte
        Next
    End If

    Set clsPaginaAnt = Nothing

    If Not pProgressBar Is Nothing Then
        pProgressBar.Value = 0
    End If
    
    If Not lLabelPaginaProgresso Is Nothing Then
        lLabelPaginaProgresso.Visible = False
    End If
    
    frmImportacao.lblParte = ""

    acrDoc.Close False
    acrPDDoc.Close
TrataErro:
    Set acrApp = Nothing
    Set clsPagina = Nothing
    Set clsPaginaAnt = Nothing
    Set acrDoc = Nothing
    Set acrPDDoc = Nothing
    Set acrPageView = Nothing
    Set acrPage = Nothing
    
    Set colClienteParte = Nothing
    Set clsParte = Nothing
    
    Screen.MousePointer = vbDefault
End Function
 

  
Sub Main()


    strLocal = "C:\Temp    este.pdf"

  If strLocal = "" Then
    MsgBox "Please drop a PDF file onto this application.", vbOKOnly, "PDF Extract"
  Else
    If Dir(strLocal) = "" Then
      MsgBox "The specified file does not exist.", vbOKOnly, "File Not Found"
    ElseIf UCase(Right(strLocal, 4)) <> ".PDF" Then
      MsgBox "The specified file is not an Adobe Acrobat file.", vbOKOnly, "Invalid File Type"
    Else
      ExtractPDF (strLocal)
    End If
  End If
End Sub


Private Sub ExtractPDF(strPath As String)
  
  'Declare our acrobat objects.
  Dim gApp As Acrobat.CAcroApp
  Dim gPDDoc As Acrobat.CAcroPDDoc
  Dim pg As Acrobat.CAcroPDPage
  Dim rect As Object
  Dim txt As Acrobat.CAcroPDTextSelect
  Dim RectAry As Acrobat.CAcroRect
  
  'Declare our counters.
  Dim lngCount As Long  'The text object counter.
  Dim lngPage As Long   'The page counter.
  
  'Declare our text objects.
  Dim strLine As String
  Dim strText As String
  Dim ary
  
  'Declare our file variables.
  Dim strDirectory As String
  Dim strFileName As String
  Dim strOutputPath As String
  
  'Create the Acrobat objects.
  Set gApp = CreateObject("AcroExch.App")
  Set gPDDoc = CreateObject("AcroExch.PDDoc")
  Set RectAry = CreateObject("AcroExch.Rect")
  
  'Setup our directory.
  strDirectory = GetDirectoryName(strPath)
  
  'Get the name of the file.
  strFileName = GetFileName(strPath)

  'Create the output file path.
  strOutputPath = strDirectory & Left(strFileName, Len(strFileName) - 3) & ".txt"
  
  'Open our output file.
  Open strOutputPath For Output As #1
          
  Set gPDDoc = CreateObject("AcroExch.PDDoc")
  
  
  
  Dim strTeste As New Collection
  Dim strPalavra As String
  Dim lngCont As Long
  
  For i = 1 To 100
        strTeste.Add "MAGNUS"
  Next

strTeste.Add "PROCED"
strTeste.Add "RELATOR"
strTeste.Add "REQTE"
strTeste.Add "ORIGEM"
strTeste.Add "REQTE.(S)"
strTeste.Add "REQDO.(A/S)"
strTeste.Add "ADV.(A/S)"
strTeste.Add "AGTE.(S)"
strTeste.Add "AGDO.(A/S)"
strTeste.Add "PROCED."
strTeste.Add "PACTE.(S)"
strTeste.Add "IMPTE.(S)"
strTeste.Add "COATOR(A/S)(ES)"
  
  Form1.Timer1.Enabled = True
  
  
  'Attempt to open the document.
  If gPDDoc.Open(strDirectory & strFileName) Then

    'Loop through all of the pages.
    For lngPage = 0 To gPDDoc.GetNumPages - 1
   
      'Get the current page.
      Set pg = gPDDoc.AcquirePage(lngPage)
    
      'Get the size of the page.
      Set rect = pg.GetSize
    
      'Setup our selection rectangle.  I cheated here, and just grabbed a really large rectangle.
      RectAry.Left = 0
      RectAry.Right = rect.x * 10
      RectAry.bottom = 0
      RectAry.Top = rect.y * 10
    
      'Create the text selection
      Set txt = gPDDoc.CreateTextSelect(lngPage, RectAry)

      strLine = ""
        
      'Loop through all of the text objects on the page.
      For lngCount = 0 To txt.GetNumText - 1
                    
        DoEvents
          
        'Get the text.
        strText = txt.GetText(lngCount)
'        Debug.Print strText
        
        
        strPalavra = strPalavra & Trim(strText)
        
        'Append this text to the line.
        strLine = strLine & strText  'vbTab & strText
        
        For lngCont = 1 To strTeste.Count
            If strPalavra = strTeste(lngCont) Then
                strLine = strPalavra
                strPalavra = ""
                Exit For
            End If
        Next
        

        
        If InStr(1, strText, vbNewLine) Then
          Print #1, strLine
          Debug.Print strLine
          strPalavra = ""
          strLine = ""
        End If
        
      Next
      
      
        Form1.Timer1.Enabled = False
        Exit For
        
    Next lngPage
       
  End If
  
  'Close this file.
  gPDDoc.Close
    
  'Close the output file.
  Close #1

  'Quit Acrobat.
  gApp.Exit

  'Let the user know we're done.
'  MsgBox "The text has been extracted from " & strFileName & ".", vbOKOnly, "Extract Complete"
  
End Sub

Function GetDirectoryName(ByVal strPath As String)
  Dim ary
  Dim lngCount As Long
  
  ary = Split(strPath, "\", -1, vbTextCompare)
  
  strPath = ""
  
  For lngCount = 0 To UBound(ary) - 1
    strPath = strPath & ary(lngCount) & "\"
  Next
  
  GetDirectoryName = strPath
End Function

Function GetFileName(strPath As String)
  GetFileName = Right(strPath, Len(strPath) - Len(GetDirectoryName(strPath)))
End Function


 

  
Set txt = gPDDoc.CreateTextSelect(lngPage, RectAry)