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]Tipos Incompativeis RecordSet

    maguim
    maguim
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 446
    Registrado : 15/05/2013

    [Resolvido]Tipos Incompativeis RecordSet Empty [Resolvido]Tipos Incompativeis RecordSet

    Mensagem  maguim em 6/6/2019, 13:46

    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?


    Última edição por maguim em 12/6/2019, 15:17, editado 1 vez(es)


    .................................................................................
    O conhecimento é a Dadiva da Vida. Sem ele o que seriamos ?! Surprised
    IvanJr.
    IvanJr.
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 652
    Registrado : 22/11/2016

    [Resolvido]Tipos Incompativeis RecordSet Empty Re: [Resolvido]Tipos Incompativeis RecordSet

    Mensagem  IvanJr. em 7/6/2019, 11:39

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

    Aguardo...


    .................................................................................
    Positive as mensagens que achar útil clicando no '+' no canto superior direito delas.
    Sempre tente entender o código, não somente copie e cole.
    maguim
    maguim
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 446
    Registrado : 15/05/2013

    [Resolvido]Tipos Incompativeis RecordSet Empty Re: [Resolvido]Tipos Incompativeis RecordSet

    Mensagem  maguim em 7/6/2019, 14:05

    ivan meu amigo

    segue,


    deu trabalharam fazer isso projeto ta grande rs Very Happy


    .................................................................................
    O conhecimento é a Dadiva da Vida. Sem ele o que seriamos ?! Surprised
    IvanJr.
    IvanJr.
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 652
    Registrado : 22/11/2016

    [Resolvido]Tipos Incompativeis RecordSet Empty Re: [Resolvido]Tipos Incompativeis RecordSet

    Mensagem  IvanJr. em 8/6/2019, 04:44

    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


    .................................................................................
    Positive as mensagens que achar útil clicando no '+' no canto superior direito delas.
    Sempre tente entender o código, não somente copie e cole.
    maguim
    maguim
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 446
    Registrado : 15/05/2013

    [Resolvido]Tipos Incompativeis RecordSet Empty Re: [Resolvido]Tipos Incompativeis RecordSet

    Mensagem  maguim em 8/6/2019, 20:27

    esta dando erro 3021 Crying or Very sad

    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


    .................................................................................
    O conhecimento é a Dadiva da Vida. Sem ele o que seriamos ?! Surprised
    IvanJr.
    IvanJr.
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 652
    Registrado : 22/11/2016

    [Resolvido]Tipos Incompativeis RecordSet Empty Re: [Resolvido]Tipos Incompativeis RecordSet

    Mensagem  IvanJr. em 10/6/2019, 01:41

    Nenhum registro atual significa problemas com seu objeto recordset.


    .................................................................................
    Positive as mensagens que achar útil clicando no '+' no canto superior direito delas.
    Sempre tente entender o código, não somente copie e cole.
    maguim
    maguim
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 446
    Registrado : 15/05/2013

    [Resolvido]Tipos Incompativeis RecordSet Empty Re: [Resolvido]Tipos Incompativeis RecordSet

    Mensagem  maguim em 10/6/2019, 12:32

    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


    .................................................................................
    O conhecimento é a Dadiva da Vida. Sem ele o que seriamos ?! Surprised
    maguim
    maguim
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 446
    Registrado : 15/05/2013

    [Resolvido]Tipos Incompativeis RecordSet Empty Re: [Resolvido]Tipos Incompativeis RecordSet

    Mensagem  maguim em 10/6/2019, 13:01

    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 Neutral Neutral


    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?


    .................................................................................
    O conhecimento é a Dadiva da Vida. Sem ele o que seriamos ?! Surprised
    IvanJr.
    IvanJr.
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 652
    Registrado : 22/11/2016

    [Resolvido]Tipos Incompativeis RecordSet Empty Re: [Resolvido]Tipos Incompativeis RecordSet

    Mensagem  IvanJr. em 11/6/2019, 11:34

    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


    .................................................................................
    Positive as mensagens que achar útil clicando no '+' no canto superior direito delas.
    Sempre tente entender o código, não somente copie e cole.
    Alexandre Fim
    Alexandre Fim
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 757
    Registrado : 13/12/2016

    [Resolvido]Tipos Incompativeis RecordSet Empty Re: [Resolvido]Tipos Incompativeis RecordSet

    Mensagem  Alexandre Fim em 11/6/2019, 12:34

    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
    maguim
    maguim
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 446
    Registrado : 15/05/2013

    [Resolvido]Tipos Incompativeis RecordSet Empty Re: [Resolvido]Tipos Incompativeis RecordSet

    Mensagem  maguim em 11/6/2019, 14:51

    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


    .................................................................................
    O conhecimento é a Dadiva da Vida. Sem ele o que seriamos ?! Surprised
    Alexandre Fim
    Alexandre Fim
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 757
    Registrado : 13/12/2016

    [Resolvido]Tipos Incompativeis RecordSet Empty Re: [Resolvido]Tipos Incompativeis RecordSet

    Mensagem  Alexandre Fim em 11/6/2019, 15:22

    Substitui pelo "dbReadOnly" e ve se funciona.

    []'s
    maguim
    maguim
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 446
    Registrado : 15/05/2013

    [Resolvido]Tipos Incompativeis RecordSet Empty Re: [Resolvido]Tipos Incompativeis RecordSet

    Mensagem  maguim em 11/6/2019, 15:50

    @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. pale

    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 Smile


    acho que estou chegando em algum ponto pra tratar isso.

    alguma sugestão?



    .................................................................................
    O conhecimento é a Dadiva da Vida. Sem ele o que seriamos ?! Surprised
    Alexandre Fim
    Alexandre Fim
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 757
    Registrado : 13/12/2016

    [Resolvido]Tipos Incompativeis RecordSet Empty Re: [Resolvido]Tipos Incompativeis RecordSet

    Mensagem  Alexandre Fim em 11/6/2019, 17:33

    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
    maguim
    maguim
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 446
    Registrado : 15/05/2013

    [Resolvido]Tipos Incompativeis RecordSet Empty Re: [Resolvido]Tipos Incompativeis RecordSet

    Mensagem  maguim em 12/6/2019, 15:09

    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 bounce  bounce  cheers  cheers


    .................................................................................
    O conhecimento é a Dadiva da Vida. Sem ele o que seriamos ?! Surprised
    IvanJr.
    IvanJr.
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 652
    Registrado : 22/11/2016

    [Resolvido]Tipos Incompativeis RecordSet Empty Re: [Resolvido]Tipos Incompativeis RecordSet

    Mensagem  IvanJr. em 13/6/2019, 00:02

    O fórum agradece o retorno. Sucesso.


    .................................................................................
    Positive as mensagens que achar útil clicando no '+' no canto superior direito delas.
    Sempre tente entender o código, não somente copie e cole.

    Conteúdo patrocinado

    [Resolvido]Tipos Incompativeis RecordSet Empty Re: [Resolvido]Tipos Incompativeis RecordSet

    Mensagem  Conteúdo patrocinado


      Data/hora atual: 18/7/2019, 16:46