[Resolvido]Tipos Incompativeis RecordSet

bom dia amigos


estou 3 dias marinando em um parte do codigo RecordCount

fiz laguma alterações na tabela e coloquei o campo como texto curto(string) antes era (memorando) só que devido alguma querys que nao funcionana em memorando tive que por pra texto curto.


Tenho um gerador de contrato via Bookmark

so que com campo memorando nao consegui importar os dados em uma tabela no bookmark da erro 13 tipos incompativeis

erro na linha abaixo:

Código:

objTable.Cell(I, 1).Range.text = rst!SOB_CATEGORIA

segue codigo completo:

Código:

Private Sub cbo_tip_anexo_AfterUpdate()
Dim db As DAO.Database
Dim rst As DAO.Recordset

'VARIAVEIS RECORDSETS
Dim VarIDPrograma As String
Dim VarCodTipoContrato As String


Dim MyMonth, MYDAY, MYYEAR
'variaveis localização
Dim NomeArquivo As String
Dim NomeWord As String
Dim TipoServico As String

'On Error GoTo ErroNuloProcedimento

NomeWord = Me.txt_programa
TipoServico = Me.cbo_tip_anexo
NomeArquivo = DLookup("Razão_Social", "BANCODEDADOSCENTRAL", "CODPASTA=" & Forms!imprimir_contrato!CODPASTA)

VarIDPrograma = DLookup("ID_PROGRAMA", "CAD_CONTR_PROGRAMAS", "Programa='" & Me.txt_programa & "'")
VarCodTipoContrato = DLookup("Cod_tip_contr", "CAD_RELAÇÃO_TIPO_CLIENTE_PROGRAMA", "PROGRAMA= '" & Forms!imprimir_contrato!LISTPROGRAMASCONTRATO & "' And Tipo_Servico = '" & Me.cbo_tip_anexo & "'")

'variaveis de datas
MyMonth = Format(Date, "mmmm")
MYDAY = Day(Date)
MYYEAR = Year(Date)


If Forms!imprimir_contrato!codHolisticus = 0 Then
MsgBox "Prestador " & NomeArquivo & "" & Chr(13) & "" & Chr(13) & " Sem Código Holisticus!!!!", vbCritical, "Atenção"
Exit Sub
ElseIf Not IsNull(Me.cbo_tip_anexo) = True Then
    DoCmd.OpenForm "SLASH CARREGAR", acNormal
    Set oApp = CreateObject("Word.Application") 'Cria e abre o objeto Word
    
    With oApp
     'Torna o MS Word visível
     .Visible = True
    
     'Abre o documento base NomeWord & " - " & TipoServico & "
     Set myDoc = oApp.Documents.Open(path & "P:\2. CREDENCIAMENTO\GESTORES\CONTRATOS_CIC\" & NomeWord & " - " & TipoServico & ".doc")
    
        .ActiveDocument.Bookmarks("COD_HOLIST").SELECT
        .Selection.text = Forms!imprimir_contrato!codHolisticus
        .ActiveDocument.Bookmarks("RAZAO_SOCIAL").SELECT
        .Selection.text = Forms!imprimir_contrato!TXT_RAZAO
        .ActiveDocument.Bookmarks("RAZAO_SOCIAL1").SELECT
        .Selection.text = Forms!imprimir_contrato!TXT_RAZAO
        .ActiveDocument.Bookmarks("RAZAO_SOCIAL2").SELECT
        .Selection.text = Forms!imprimir_contrato!TXT_RAZAO
        
        'DIA MES E ANO EMITIDO DO DIA ATUAL
        .ActiveDocument.Bookmarks("DIA").SELECT
        .Selection.text = MYDAY
        .ActiveDocument.Bookmarks("MES").SELECT
        .Selection.text = MyMonth
        .ActiveDocument.Bookmarks("ANO").SELECT
        .Selection.text = MYYEAR
    
      ' INSERI TABELA DE PROCEDIMENTOS
      Set db = CurrentDb
      Set rst = db.OpenRecordset("select * from SUB_CATEGORIA where id_geral= " & Forms!imprimir_contrato!CODPASTA & " AND ID_PROGRAMA = " & VarIDPrograma & " and Cod_tip_contr= '" & VarCodTipoContrato & "'")
      
      
     myDoc.Tables.Add Range:=oApp.ActiveDocument.Range.Bookmarks("tabela").Range, NumRows:=rst.RecordCount, NumColumns:=3
    
      Set objTable = myDoc.Tables(1)
      
      objTable.Borders.Enable = True
    
      For I = 1 To rst.RecordCount
            objTable.Cell(I, 1).Range.text = rst!SOB_CATEGORIA
            objTable.Cell(I, 2).Range.text = Nz(rst!COD_TUSS)
            objTable.Cell(I, 3).Range.text = rst!VALORES
            rst.MoveNext
      Next I

    'oApp.ActiveDocument.SaveAs Environ$("USERPROFILE") & "\Desktop\CONTRATOS E ANEXOS" & "\" & Nz(Replace(NomeArquivo, " ", " ")) & _
    '" - " & Format(Now, "DD.MM.YYYY") & "____" & Forms!IMPRIMIR_CONTRATO!codHolisticus & ".doc"
    oApp.ActiveDocument.SaveAs Environ$("USERPROFILE") & "\Desktop\CONTRATOS E ANEXOS\" & NomeWord & "____" & Forms!imprimir_contrato!codHolisticus & "__" & Me.cbo_tip_anexo & "____" & NomeArquivo & " - " & Format(Now, "DD.MM.YYYY") & ".pdf", 17
    oApp.ActiveDocument.Close SaveChanges:=False


    
    'Fecha o documento
    .WindowState = wdWindowStateMaximize
    'Fecha o Word
    oApp.Quit
    DoCmd.Close acForm, "SLASH CARREGAR", acSaveYes
    MsgBox "" & Forms!imprimir_contrato!LISTPROGRAMASCONTRATO & " " & Chr(13) & " " & Chr(13) & " " & NomeArquivo & " " & Chr(13) & " " & Chr(13) & " " & Chr(13) & " Gerado com Sucesso!!!", vbInformation, "Anexo "
    End With
    


End If


'ErroNuloProcedimento:
'If Err.Number = 5148 Then
'MsgBox "Prestador: " & NomeArquivo & " " & Chr(13) & "" & Chr(13) & "Não tem Procedimentos Cadastrados no contrato  " & Chr(13) & "" & Chr(13) & " " & Forms!imprimir_contrato!LISTPROGRAMASCONTRATO & "", vbCritical
'oApp.ActiveDocument.Close SaveChanges:=False
'oApp.Quit
'DoCmd.Close acForm, "SLASH CARREGAR", acSaveYes
'Me.cbo_tip_anexo = Null

'ElseIf Err.Number = 13 Then
'MsgBox "Prestador: " & NomeArquivo & " " & Chr(13) & "" & Chr(13) & "Não tem Contrato Pré Estabelecido" & Chr(13) & "" & Chr(13) & " Favor Falar com Gerencia!!!" & Chr(13) & "" & Chr(13) & " " & Forms!imprimir_contrato!LISTPROGRAMASCONTRATO & "", vbCritical
'oApp.Quit
'DoCmd.Close acForm, "SLASH CARREGAR", acSaveYes
'Me.cbo_tip_anexo = Null

'ElseIf Err.Number = 94 Then
'MsgBox "Prestador: " & NomeArquivo & " " & Chr(13) & "" & Chr(13) & "Não tem Procedimento Cadastrado no Programa: " & NomeWord & " " & Chr(13) & "" & Chr(13) & " ", vbCritical
'DoCmd.Close acForm, "SLASH CARREGAR", acSaveYes
'Me.cbo_tip_anexo = Null
'End If









End Sub

alguem pode dar um luz?

Tire uma cópia, apague os dados reais, insira informações falsas e anexe aqui para que possamos auxiliar mais precisamente.

Aguardo...

ivan meu amigo

segue,


deu trabalharam fazer isso projeto ta grande rs

Tente primeiro salvar o valor do campo em uma variável e depois usar.

Código:

Private Sub cbo_tip_anexo_AfterUpdate()

...
Dim strTemp as String
...
   
      For I = 1 To rst.RecordCount
            strTemp = rst!SOB_CATEGORIA
            objTable.Cell(I, 1).Range.text = strTemp
            ...
      Next I

End Sub

esta dando erro 3021

nenhum registro atual.


e pior que ele lança no word o recordset mas esta vindo com linhas em branco.

Código:

   
Dim strTemp As String


For I = 1 To rst.RecordCount
            strTemp = rst!SOB_CATEGORIA
            objTable.Cell(I, 1).Range.text = strTemp
            objTable.Cell(I, 2).Range.text = Nz(rst!COD_TUSS)
            objTable.Cell(I, 3).Range.text = rst!VALORES
            rst.MoveNext
      Next I

Nenhum registro atual significa problemas com seu objeto recordset.

bom dia! ivan

então ao me ver o recordset esta certo. você faria algo diferente?

segue o codigo do recordset:

Código:

Dim db As DAO.Database
Dim rst As DAO.Recordset

Dim VarIDPrograma As String
Dim VarCodTipoContrato As String

VarIDPrograma = DLookup("ID_PROGRAMA", "CAD_CONTR_PROGRAMAS", "Programa='" & Me.txt_programa & "'")
VarCodTipoContrato = DLookup("Cod_tip_contr", "CAD_RELAÇÃO_TIPO_CLIENTE_PROGRAMA", "PROGRAMA= '" & Forms!imprimir_contrato!LISTPROGRAMASCONTRATO & "' And Tipo_Servico = '" & Me.cbo_tip_anexo & "'")



' INSERI TABELA DE PROCEDIMENTOS
      Set db = CurrentDb
      Set rst = db.OpenRecordset("select * from SUB_CATEGORIA where id_geral= " & Forms!imprimir_contrato!CODPASTA & " AND ID_PROGRAMA = " & VarIDPrograma & " and Cod_tip_contr= '" & VarCodTipoContrato & "'")
     
     
    myDoc.Tables.Add Range:=oApp.ActiveDocument.Range.Bookmarks("tabela").Range, NumRows:=rst.RecordCount, NumColumns:=3
   
      Set objTable = myDoc.Tables(1)
     
      objTable.Borders.Enable = True
   
      For I = 1 To rst.RecordCount
            objTable.Cell(I, 1).Range.text = rst!SOB_CATEGORIA
            objTable.Cell(I, 2).Range.text = Nz(rst!COD_TUSS)
            objTable.Cell(I, 3).Range.text = rst!VALORES
            rst.MoveNext
      Next I

abraços

troquei tipo de dados na tabela CAD_RELAÇÃO_TIPO_CLIENTE_PROGRAMA e coloquei o Cod_tip_contr como numero antes estava com string

mudei as variaveis para integer:

Código:

Dim VarIDPrograma As Integer
Dim VarCodTipoContrato As Integer

ainda mesmo assim esta com mesmo problema


fiz algumas alteração no recordcount e parece que agr funcionou, porem ele esta migrando com cedulas de tabela como null, tentei por nz na hora de gerar a tabela, mas nao deu certo ele gera o contrato sem erro como estava dando antes e com nulos


segue codigo da alteração que fiz:

Código:

           For I = 1 To rst.RecordCount
            Next I
            
            If rst.RecordCount = 0 Then
            Exit Sub
            Else
            objTable.Cell(I, 1).Range.text = Nz(rst!SOB_CATEGORIA)
            objTable.Cell(I, 2).Range.text = Nz(rst!COD_TUSS)
            objTable.Cell(I, 3).Range.text = Nz(rst!VALORES)
            rst.MoveNext
            
            End If

segue imagem para entender o que estou dizendo.
http://uploaddeimagens.com.br/imagens/erro_recordset-jpg

descobri que o recordcount esta contando 4 inserção de dados e esta lançando somente 1 (o correto),  e os outros 3 esta vindo null

Código:

ID_PROGRAMA1      |Cod_tip_contr1        |SOB_CATEGORIA
16                |1                     |RM CRANIO / ENCEFALO NAIVE
16                |1                     |RM CRANIO / ENCEFALO SEGURANÇA  / EFICACIA
16                |1                     |RM ORBITA / SEGURANÇA / EFICACIA
16                |2                     |INSTALAÇÃO DE BOMBA DE INFUSÃO PARA ANALGESIA EM DOR AGUDA OU CRÔNICA, POR QUALQUER VIA



Código:

ID_PROGRAMA1      |Cod_tip_contr1        |SOB_CATEGORIA
16                |1                     |null
16                |1                     |null
16                |1                     |null
16                |2                     |INSTALAÇÃO DE BOMBA DE INFUSÃO PARA ANALGESIA EM DOR AGUDA OU CRÔNICA, POR QUALQUER VIA



tem como tratar isso ou mudar todo recordset?

Antes de criar um comando select pro recordset eu crio uma consulta para saber os dados que serão retornados e ter certeza de que o comando está trazendo o que deveria trazer. Saber se relacionei as tabelas como deveria etc. Tente fazer o mesmo e saber como o recordset está trazendo seus registros.

No mais, uma forma melhorada do seu comando seria

Código:

If rst.RecordCount > 0 then
    For I = 1 To rst.RecordCount
          'a estrutura condicional abaixo só permite levar para a tabela registros em que os três campos tenham dados
          'adapte conforme julgar necessário
          if Nz(rst!SOB_CATEGORIA) <> "" and Nz(rst!COD_TUSS) <> "" and Nz(rst!VALORES) <> "" then
              objTable.Cell(I, 1).Range.text = Nz(rst!SOB_CATEGORIA)
              objTable.Cell(I, 2).Range.text = Nz(rst!COD_TUSS)
              objTable.Cell(I, 3).Range.text = Nz(rst!VALORES)
          end if
          rst.MoveNext
    Next I
End if

'nunca esqueça de descarregar seus recordsets da memória
rst.close
set rst = nohing

Maguin bom dia,

A propriedade "RecordCount" do recordset ela funciona se vc utilizar a constante "dbOpenSnapshot" ou "dbReadOnly".

Tente isto !!!

Código:



    Dim sSQL As String
   
    Set Db = CurrentDb
   
    sSQL = "SELECT * FROM SUB_CATEGORIA "
    sSQL = sSQL & " WHERE id_geral= " & Forms!imprimir_contrato!CODPASTA & " "
    sSQL = sSQL & " AND ID_PROGRAMA = " & VarIDPrograma & " "
    sSQL = sSQL & " AND Cod_tip_contr= '" & VarCodTipoContrato & "'"
   
    Set rst = Db.OpenRecordset(sSQL, dbOpenSnapshot)

    if rst.RecordCount > 0 then ...




Boa sorte.

[]'s

amigos,

descobri que o recordcount lança o primeiro registro ok, porem não existem mais registros pra ele lançar e por isso ele esta crashando.


exemplo:
count = 4

loop lança 4
looping 1 = ok dados lançados
looping 2 = nenhum registro da query... aqui ele erro.
looping 3 = nenhum registro da query... aqui ele erro.
looping 4 = nenhum registro da query... aqui ele erro.


tem como tratar o nao tem registro encontrado no loop?


descobri outras coisas.
se eu não colocar dbOpenSnapshot. Ele faz a contagem errado diz que só tem 1 dado sendo que existe 78 enfim.

existe algum tipo recordcount tratar isso?

sei lá...

dbOpenDynaset
dbOpenForwardOnly
dbOpenTable
dbAppendOnly
dbSQLPassThrough
dbReadOnly
etc
etc
etc

Substitui pelo "dbReadOnly" e ve se funciona.

[]'s

@alexandre

não deu certo, o recordcount esta com contagem = 1 em vez do real numero.


quando usa as propriedades dos recordsets

dbOpenDynaset
dbOpenForwardOnly
dbOpenTable
dbAppendOnly
dbSQLPassThrough
dbReadOnly
etc
etc
etc

o recordset não faz as contagens corretas.

tinha que dar um jeito de tratar no looping isso entendeu?

looping do looping


ou tratar o rst.PercentPosition ?

antes nao existe erro pra esta condição

agr testei assim:

Código:

If rst.RecordCount > 0 Then
    For I = 1 To rst.RecordCount
          If I And rst.PercentPosition <> "" Then
              objTable.Cell(I, 1).Range.text = Nz(rst!SOB_CATEGORIA)
              objTable.Cell(I, 2).Range.text = Nz(rst!COD_TUSS)
              objTable.Cell(I, 3).Range.text = Nz(rst!VALORES)
          End If
          rst.MoveNext
    Next I
End If

e agr aparece erro 3021


acho que estou chegando em algum ponto pra tratar isso.

alguma sugestão?

Maguim,

Se ele está trazendo RecordCount = 1, provavelmente ele esta trazendo o recordset com 1 linha vazia.
É melhor você utilizar o EOF (End Of File) do recordset, pois nesta condição, ele vai trazer TRUE, ou seja, sem registros.

Como o IvanJr mencionou, reproduza seu código na consulta e veja se traz algum resultado.
Talvez esteja faltando alguma informação.

Espero ter ajudado.

[]'s

Caro amigos!!!
muito obrigado a todos, gostaria de dar thank a todos, porem como todos deu um parcela de ajuda não posso beneficiar uma pessoa só.


o que eu fiz?

Me corrigem se eu tiver errado!

fiz um verificação de .EOF, após executar o recordset, dica do nosso amigo @alexandre com contribuição do @ivan (com a verificações de nulos).

referencias:
EOF dica MaximoAccess
DOCUMENTAÇÃO MICROSOFT
MECANISMO EOF


Descobri que o recordcount faz um varedura geral de contagens. E isso estava sobrepondo o recordcount com numero total da table no word.

Código:

myDoc.Tables.Add Range:=oApp.ActiveDocument.Range.Bookmarks("tabela").Range, NumRows:=rst.RecordCount, NumColumns:=3

Código:

NumRows:=rst.RecordCount

Entao ao verificar com breakline. Acabei percebendo que o recordcount estava tendo um contagem geral independente do recordset declarado.

Código:

Set rst = db.OpenRecordset("select * from SUB_CATEGORIA where id_geral= " & Forms!imprimir_contrato!CODPASTA & " AND Cod_tip_contr= " & VarCodTipoContrato & " and ID_PROGRAMA = " & VarIDPrograma)

Então fiz um verificação End of File para falso se tiver todos os dados do recordset preenchido e verdadeiro e não tiver.

Código:

     Set rst = db.OpenRecordset("select * from SUB_CATEGORIA where id_geral= " & Forms!imprimir_contrato!CODPASTA & " AND Cod_tip_contr= " & VarCodTipoContrato & " and ID_PROGRAMA = " & VarIDPrograma)
        If rst.EOF = False Then
        rst.MoveLast
        rst.MoveFirst
        End If

após isso verificação em conjunto com EOF, onde se loop estiver casado com EOF ele executa o looping se não ele vai dar erro:

Código:

   If rst.RecordCount > 0 Then
         For I = 1 To rst.RecordCount
              If I And rst.EOF = False Then
                   objTable.Cell(I, 1).Range.text = Nz(rst!SOB_CATEGORIA)
                   objTable.Cell(I, 2).Range.text = Nz(rst!COD_TUSS)
                   objTable.Cell(I, 3).Range.text = Nz(rst!VALORES)
                rst.MoveNext
              End If
            Next I
    End If

segue o codigo geral da minha explicação:

Código:

Private Sub cbo_tip_anexo_AfterUpdate()
Dim db As dao.Database
Dim rst As dao.Recordset
Dim MyMonth, MYDAY, MYYEAR
Dim C As Variant

'variaveis localização
Dim NomeArquivo As String
Dim NomeWord As String
Dim TipoServico As String

'VARIAVEIS RECORDSETS
Dim VarIDPrograma As Integer
Dim VarCodTipoContrato As Integer

'On Error GoTo ErroNuloProcedimento

NomeWord = Me.txt_programa
TipoServico = Me.cbo_tip_anexo
NomeArquivo = DLookup("Razão_Social", "BANCODEDADOSCENTRAL", "CODPASTA=" & Forms!imprimir_contrato!CODPASTA)

VarIDPrograma = DLookup("ID_PROGRAMA", "CAD_CONTR_PROGRAMAS", "Programa='" & Me.txt_programa & "'")
VarCodTipoContrato = DLookup("Cod_tip_contr", "CAD_RELAÇÃO_TIPO_CLIENTE_PROGRAMA", "PROGRAMA= '" & Forms!imprimir_contrato!LISTPROGRAMASCONTRATO & "' And Tipo_Servico = '" & Me.cbo_tip_anexo & "'")

'variaveis de datas
MyMonth = Format(Date, "mmmm")
MYDAY = Day(Date)
MYYEAR = Year(Date)


If Forms!imprimir_contrato!codHolisticus = 0 Then
MsgBox "Prestador " & NomeArquivo & "" & Chr(13) & "" & Chr(13) & " Sem Código Holisticus!!!!", vbCritical, "Atenção"
Exit Sub
ElseIf Not IsNull(Me.cbo_tip_anexo) = True Then
    DoCmd.OpenForm "SLASH CARREGAR", acNormal
    Set oApp = CreateObject("Word.Application") 'Cria e abre o objeto Word
    
    With oApp
     'Torna o MS Word visível
     .Visible = True
    
     'Abre o documento base NomeWord & " - " & TipoServico & "
     Set myDoc = oApp.Documents.Open(path & "C:\Users\natha\Desktop\teste azimuteeee\" & NomeWord & " - " & TipoServico & ".doc")
    
        .ActiveDocument.Bookmarks("COD_HOLIST").SELECT
        .Selection.text = Forms!imprimir_contrato!codHolisticus
        .ActiveDocument.Bookmarks("RAZAO_SOCIAL").SELECT
        .Selection.text = Forms!imprimir_contrato!TXT_RAZAO
        .ActiveDocument.Bookmarks("RAZAO_SOCIAL1").SELECT
        .Selection.text = Forms!imprimir_contrato!TXT_RAZAO
        .ActiveDocument.Bookmarks("RAZAO_SOCIAL2").SELECT
        .Selection.text = Forms!imprimir_contrato!TXT_RAZAO
        
        'DIA MES E ANO EMITIDO DO DIA ATUAL
        .ActiveDocument.Bookmarks("DIA").SELECT
        .Selection.text = MYDAY
        .ActiveDocument.Bookmarks("MES").SELECT
        .Selection.text = MyMonth
        .ActiveDocument.Bookmarks("ANO").SELECT
        .Selection.text = MYYEAR
    
      ' INSERI TABELA DE PROCEDIMENTOS
      Set db = CurrentDb
      Set rst = db.OpenRecordset("select * from SUB_CATEGORIA where id_geral= " & Forms!imprimir_contrato!CODPASTA & " AND Cod_tip_contr= " & VarCodTipoContrato & " and ID_PROGRAMA = " & VarIDPrograma)
        If rst.EOF = False Then
        rst.MoveLast
        rst.MoveFirst
        End If

      
     myDoc.Tables.Add Range:=oApp.ActiveDocument.Range.Bookmarks("tabela").Range, NumRows:=rst.RecordCount, NumColumns:=3
    
      Set objTable = myDoc.Tables(1)
      
      objTable.Borders.Enable = True
    
    If rst.RecordCount > 0 Then
         For I = 1 To rst.RecordCount
              If I And rst.EOF = False Then
                   objTable.Cell(I, 1).Range.text = Nz(rst!SOB_CATEGORIA)
                   objTable.Cell(I, 2).Range.text = Nz(rst!COD_TUSS)
                   objTable.Cell(I, 3).Range.text = Nz(rst!VALORES)
                rst.MoveNext
              End If
            Next I
    End If





    'oApp.ActiveDocument.SaveAs Environ$("USERPROFILE") & "\Desktop\CONTRATOS E ANEXOS" & "\" & Nz(Replace(NomeArquivo, " ", " ")) & _
    '" - " & Format(Now, "DD.MM.YYYY") & "____" & Forms!IMPRIMIR_CONTRATO!codHolisticus & ".doc"
    oApp.ActiveDocument.SaveAs Environ$("USERPROFILE") & "\Desktop\teste azimuteeee\" & NomeWord & "____" & Forms!imprimir_contrato!codHolisticus & "__" & Me.cbo_tip_anexo & "____" & NomeArquivo & " - " & Format(Now, "DD.MM.YYYY") & ".pdf", 17
    oApp.ActiveDocument.Close SaveChanges:=False


    
    'Fecha o documento
    .WindowState = wdWindowStateMaximize
    'Fecha o Word
    oApp.Quit
    DoCmd.Close acForm, "SLASH CARREGAR", acSaveYes
    MsgBox "" & Forms!imprimir_contrato!LISTPROGRAMASCONTRATO & " " & Chr(13) & " " & Chr(13) & " " & NomeArquivo & " " & Chr(13) & " " & Chr(13) & " " & Chr(13) & " Gerado com Sucesso!!!", vbInformation, "Anexo "
    End With
    


End If


'ErroNuloProcedimento:
'If Err.Number = 5148 Then
'MsgBox "Prestador: " & NomeArquivo & " " & Chr(13) & "" & Chr(13) & "Não tem Procedimentos Cadastrados no contrato  " & Chr(13) & "" & Chr(13) & " " & Forms!imprimir_contrato!LISTPROGRAMASCONTRATO & "", vbCritical
'oApp.ActiveDocument.Close SaveChanges:=False
'oApp.Quit
'DoCmd.Close acForm, "SLASH CARREGAR", acSaveYes
'Me.cbo_tip_anexo = Null

'ElseIf Err.Number = 13 Then
'MsgBox "Prestador: " & NomeArquivo & " " & Chr(13) & "" & Chr(13) & "Não tem Contrato Pré Estabelecido" & Chr(13) & "" & Chr(13) & " Favor Falar com Gerencia!!!" & Chr(13) & "" & Chr(13) & " " & Forms!imprimir_contrato!LISTPROGRAMASCONTRATO & "", vbCritical
'oApp.Quit
'DoCmd.Close acForm, "SLASH CARREGAR", acSaveYes
'Me.cbo_tip_anexo = Null

'ElseIf Err.Number = 94 Then
'MsgBox "Prestador: " & NomeArquivo & " " & Chr(13) & "" & Chr(13) & "Não tem Procedimento Cadastrado no Programa: " & NomeWord & " " & Chr(13) & "" & Chr(13) & " ", vbCritical
'DoCmd.Close acForm, "SLASH CARREGAR", acSaveYes
'Me.cbo_tip_anexo = Null
'End If

End Sub

OBG TODOS      

O fórum agradece o retorno. Sucesso.