Excel como limitar o numero de caracteres extraídos de 1 linha excel-vba

[Guto Lima]

boa tarde!

preciso de ajuda com um código vba.

criei um código vba no qual copia os dados de um documento "PDF" e cola em uma planilha chamada "dados" no excel, no qual tenho que extrair alguns dados, como o nome e código do estabelecimento, data de nascimento código de procedimentos entre outros.

o problema que eu utilizei um código que encontrei no youtube no qual ele delimita correctamente a partir de qual palavra ira começar a extração de dados de 1 linha porém não determina quando parar de copiar, fazendo com que copie todo o restante da linha.

por exemplo: 

codigo-vba:

If Not pDados.Range("A" & linha).Find("Nascimento:") Is Nothing Then
  pDados.Range("E" & pDados.Range("E1").End(xlDown).Row + 1) = _
  Mid(pDados.Range("A" & linha), InStr(1, pDados.Range("A" & linha), ":") + 1, Len(pDados.Range("A" & linha)))

 

Fonte de extracção

PAULO RUBENS LEMES DE OLIVEIRA Nascimento:07/07/1970 Especialidade: 03

 

o código acima solicita que seja extraído da fonte de extracção toda a informação que estiver após a palavra "Nascimento:" e ai que esta o problema, eu não quero que, o que esta após a data "07/07/1970" seja extraído também.

para isso preciso complementar este código com uma limitação de até onde deve ser copiado a informação, um código que diga  tipo extrair os 10 primeiros caracteres (não importando se são números, espaços, letras ou símbolos) após a palavra "Nascimento", e de preferência que seja neste mesmo padrão pois o fato ocorre também com outros dados porém de as vezes preciso extrair o nome porém a data de nascimento junto, ou preciso extrair o código de um procedimento mas vem junto também a descrição do mesmo ou símbolos.

obs1 : se alguém puder me ajudar a cria também um código para pegar o nome dos pacientes, pois não sei como escrever um código para copiar os dados da linha abaixo da palavra estabelecimento.

obs2: sou completamente amador nisto, conhecimento zero, por isso se alguém puder me ajudar reescrevendo o código  eu agradeço.

 

código completo - caso seja necessário: 

'cria uma plnilha chamada DADOS
    For Each planilha In ThisWorkbook.Worksheets
    If planilha.Name = "DADOS" Then
    Application.DisplayAlerts = False
    planilha.Delete
    Application.DisplayAlerts = True
    Exit For
    End If
    Next
    Worksheets.Add.Name = "DADOS"
    Set pDados = ThisWorkbook.Worksheets("DADOS")
    
    'interação com PDF (Acrobat Reader)
    caminhoAdobeReader = "C:\Program Files\Adobe\Acrobat DC\Acrobat\Acrobat.exe"
    caminhoArquivo = "D:\extratores\bloqueados\bloqueadas.pdf"
    Call Shell(caminhoAdobeReader & " """ & caminhoArquivo & """", vbNormalFocus)
    Application.Wait Now + TimeValue("00:00:05")
    SendKeys "^a" 'CTRL + A
    SendKeys "^c" 'CTRL + C
    Application.Wait Now + TimeValue("00:00:03")
    pDados.Paste Destination:=pDados.Range("A1")
    Call Shell("taskkill  /F /IM Acrobat.exe")
    
    'cria o cabeçalho da tabela
    pDados.Range("B1") = "zero": pDados.Range("B2") = "."
    pDados.Range("C1") = "ESTABELECIMENTO": pDados.Range("C2") = "."
    pDados.Range("D1") = "PACIENTE": pDados.Range("D2") = "."
    pDados.Range("E1") = "NASCIMENTO": pDados.Range("E2") = "."
    pDados.Range("F1") = "AIH": pDados.Range("F2") = "."
    pDados.Range("G1") = "DIAGNOSTICO": pDados.Range("G2") = "."
    pDados.Range("H1") = "INTERNAÇÃO": pDados.Range("H2") = "."
    pDados.Range("I1") = "SAÍDA": pDados.Range("I2") = "."
    pDados.Range("J1") = "PROC.SOLICITADO": pDados.Range("J2") = "."
    pDados.Range("K1") = "MÉDICO SOL": pDados.Range("K2") = "."
    pDados.Range("L1") = "PROC.REALIZADO": pDados.Range("L2") = "."
    pDados.Range("M1") = "MÉD.RE": pDados.Range("M2") = "."
    pDados.Range("N1") = "M DE SAÍDA": pDados.Range("N2") = "."
    pDados.Range("O1") = "PRÉVIA": pDados.Range("O2") = "."
    pDados.Range("P1") = "MOTIVO BLOQ./CANC.": pDados.Range("P2") = "."
        
  'extrai informações
  For linha = 1 To pDados.Range("A1").CurrentRegion.Rows.Count
  Application.Wait Now + TimeValue("00:00:01")
  'zero
  
  If IsNumeric(Mid(pDados.Range("A" & linha), 1, 1)) And _
  Mid(pDados.Range("A" & linha), 2, 1) = "." And _
  IsNumeric(Mid(pDados.Range("A" & linha), 3, 1)) And _
  Mid(pDados.Range("A" & linha), 4, 1) = "." Then
  pDados.Range("B" & pDados.Range("B1").End(xlDown).Row + 1) = Mid(pDados.Range("A" & linha), 6, Len(pDados.Range("A" & linha)))
  
  End If
  
  'ESTABELECIMENTO
  
  If Not pDados.Range("A" & linha).Find("Estabelecimento:") Is Nothing Then
  pDados.Range("C" & pDados.Range("C1").End(xlDown).Row + 1) = _
  Mid(pDados.Range("A" & linha), InStr(1, pDados.Range("A" & linha), ":") + 2, Len(pDados.Range("A" & linha)))
  
  End If
  
  'estabelecimento
  
   If Not pDados.Range("A" & linha).Find("Nascimento:") Is Nothing Then
  pDados.Range("E" & pDados.Range("E1").End(xlDown).Row + 1) = _
  Mid(pDados.Range("A" & linha), InStr(1, pDados.Range("A" & linha), ":") + 1, Len(pDados.Range("A" & linha)))
  
  End If
  
  'AIH
  
  If Not pDados.Range("A" & linha).Find("AIH:") Is Nothing Then
  pDados.Range("F" & pDados.Range("F1").End(xlDown).Row + 1) = _
  Mid(pDados.Range("A" & linha), InStr(1, pDados.Range("A" & linha), ":") + 1, Len(pDados.Range("A" & linha)))
  
  End If
  Next
End Sub

[Muca Costa]

Dúvidas sem uma planilha anexada, fica complicado lhe ajudar...

[DJunqueira]

Pois é, imagina alguém querendo te ajudar e tendo de refazer toda a sua planilha.
Corrigir código só de olhar não é p/ qq um, ainda mais sem ter como conferir o resultado.
 

Uma das melhores forma de importar dados p/ o Excel é através do Power Query, mas p/ isso você teria de converter o PDF p/ alguma outra forma de arquivo, isso seria possível?
Os dados poderiam ser acessados através de uma página da internet?