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

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