Originally Posted by
ipisors
First, the last post is definitely something I'd strongly agree with and not just for this situation, but
because of this situation you can see what a bad practice it is to have a bunch of different CreatePDF## functions when you should instead be doing CreatePDF(param). It's a bad practice that's not scalable and you should take the time to fix it now instead of incurring more 'technology debt'.......
But..you can do this:
Code:
Do Until Dir("file path of the created PDF file you are expecting")<>""
'Do Nothing
Loop
Thanks Isaac. I placed that lines after CrearPDF and it crushes. I don't know where I could fit it.
Okay, here is my "Create PDF" function. I think I did my homework. So far, each record has it's own report, but now laws in my sector have changed and now I need to print 2 report types for some records.
Code:
Public Sub CreaInformePDF(ByVal strSQL As String, Optional ByVal blnNoPreguntar As Boolean)
'Crear el informe PDF de un recordset definido por la SQL enviada
'Necesita NumAnalisis, FechaRecogida, NumFactura, Nombre (del cliente), Origen de la Muestra, IdTipoAnalisis(Id AS...), TipoAnalisis (descripción), Administración.
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim intCuentaRegistros As Integer
Dim strMensaje As String
Dim lngRespuesta As Long
Set db = CurrentDb()
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
If rs.RecordCount < 1 Then 'Evita que se ejecute el proceso si no hay registros
MsgBox "No hay registros seleccionados", vbExclamation
Else
rs.MoveLast 'es necesario este paso para que cuente bien los registros
intCuentaRegistros = rs.RecordCount
rs.MoveFirst
strMensaje = "Atención, va a crear " & intCuentaRegistros & " informes analíticos en PDF." & vbCrLf & "¿Está seguro?"
'Este bloque permite que se ejecute el procedimiento sin pedir confirmación al usuario.
If blnNoPreguntar = True Then
lngRespuesta = vbOK
Else
lngRespuesta = MsgBox(strMensaje, vbExclamation + vbOKCancel + vbDefaultButton2, "Crear PDFs")
End If
Select Case lngRespuesta
Case vbOK
Do While Not rs.EOF
Dim strDocName As String
Dim strFileName As String
Dim datfechaReco As Date
Dim strMesReco As String
Dim strAnioReco As String
Dim strAdmon As String
Dim strDirActual As String
Dim strDirInforme As String
'Informe que se abre
strDocName = NombreInformeAnalisis(rs!IdTipoAnalisis)
'Directorios
strDirActual = Left(CurrentDb.Name, Len(CurrentDb.Name) - Len(Dir(CurrentDb.Name)))
If Not IsNull(rs!Admon) Then
strAdmon = rs!Admon
Else
strAdmon = ""
End If
datfechaReco = rs!FechaRecogida
strMesReco = Format(datfechaReco, "mmmm")
strMesReco = UCase(strMesReco)
strAnioReco = Format(datfechaReco, "YYYY")
'Probando si el directorio existe.
'Probando si existe el directorio "informes"
strDirInforme = strDirActual & "DOCS LABORATORIO" & "\"
If Len(Dir(strDirInforme, vbDirectory)) = 0 Then
'Crear si no existe.
MkDir strDirInforme
End If
'Probando los siguientes.
strDirInforme = strDirInforme & strMesReco & " " & strAnioReco & "\"
If Len(Dir(strDirInforme, vbDirectory)) = 0 Then
MkDir strDirInforme
End If
If strAdmon <> "" Then 'Se crea solo si hay admon.
strDirInforme = strDirInforme & strAdmon & "\"
If Len(Dir(strDirInforme, vbDirectory)) = 0 Then
MkDir strDirInforme
End If
End If
'Nombre del archivo
strFileName = strDirInforme & "Informe nº" & rs!NumAnalisis & " " & rs!Nombre & "-" & rs![Origen de la Muestra] & " - " & rs!TipoAnalisis & " - " & strMesReco & " " & strAnioReco & ".pdf"
Application.Echo False
DoCmd.OpenReport strDocName, acPreview, , "NumAnalisis = " & Nz(rs!NumAnalisis, 0)
DoCmd.OutputTo acOutputReport, strDocName, acFormatPDF, strFileName, , , , acExportQualityPrint
DoCmd.Close acReport, strDocName
Application.Echo True
'Memoriza el nombre del archivo para enviar por email
strArchivosAdjuntos = strArchivosAdjuntos & strFileName & ";"
rs.MoveNext
Loop
strArchivosAdjuntos = Left(strArchivosAdjuntos, Len(strArchivosAdjuntos) - 1)
Case vbCancel
MsgBox "Ha interrumpido el proceso"
Case Else
MsgBox lngRespuesta
End Select
End If
Set rs = Nothing
Set db = Nothing
End Sub