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

    Error OutputTo, Não é possivel abrir mais tabelas. VBA 3014

    Compartilhe

    mateusbr01
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 8
    Registrado : 10/08/2015

    Error OutputTo, Não é possivel abrir mais tabelas. VBA 3014

    Mensagem  mateusbr01 em Ter 15 Ago 2017, 15:47

    Apos utilizar esse codigo por volta de 450 vezes, o access da o erro dizendo que não pode mais abrir tabelas, e para a geração de PDF's

    -------------------------- Chamada VBA --------------------------
    DoCmd.OpenReport "Impr_Incr_Exame_Invest", acViewReport, , "[cpf] = '" & auxCPF & "'", acIcon
    exeSQL ("UPDATE Tbl_Assinatura SET caminho_arquivo = '" & fncGerarPDF("Impr_Incr_Exame_Invest", "Exame_Investidura_" & auxCPF & "_" & auxNome, True, 17) & "' WHERE pk_ass = " & auxAss)
    DoCmd.Close acReport, "Impr_Incr_Exame_Invest", acSaveNo

    -------------------------- Função --------------------------

    Function fncGerarPDF(Relatorio As String, assunto As String, SalvarServidor As Boolean, tipo_doc As Integer, Optional AnoAutomatico As String = "2017") As String
    Dim strArquivo As String, strLocal As String, strAssunto As String, strPasta As String, axTipo As String, axAno As String

    strPasta = Replace(DLookup("[caminho]", "Tbl_Tipo_Documentos", "[pk_tipo] = " & tipo_doc), "/", "\")

    strAssunto = assunto
    strAssunto = Replace(strAssunto, "/", " ")
    strAssunto = Replace(strAssunto, ":", " ")
    strArquivo = strAssunto & ".pdf"

    If SalvarServidor Then
    strLocal = "\\200.17.33.110\rh\SIPPAG\PDF"
    axTipo = Replace(strPasta, "\2017", "")
    axAno = AnoAutomatico

    If Dir(strLocal, vbDirectory) = "" Then MkDir (strLocal)
    strLocal = strLocal & "\" & axTipo
    If Dir(strLocal, vbDirectory) = "" Then MkDir (strLocal)
    strLocal = strLocal & "\" & axAno
    If Dir(strLocal, vbDirectory) = "" Then MkDir (strLocal)
    Else
    strLocal = fncLocalizarPasta("Salvar Arquivo")
    End If
    DoCmd.OutputTo acOutputReport, Relatorio, acFormatPDF, strLocal & "\" & strArquivo
    fncGerarPDF = Replace(strPasta & "\" & strArquivo, "\", "/")
    'MsgBox "Arquivo gerado na pasta " & strLocal, vbInformation, "Arquivo PDF gerado com sucesso!!!"
    'Application.CutCopyMode = False

    End Function

      Data/hora atual: Sab 18 Nov 2017, 19:15