¿Cómo puedo hacer duplicados de pdf en una selección múltiple?

Tengo un formulario con una serie de registros de facturas en formato tabular. He añadido 2 columnas: una de tipo si/no y otra con un botón para seleccionar las facturas que necesito duplicar.

También he añadido un botón en el encabeza para seleccionar todos o ningún registro.

El botón para duplicar las facturas de forma independiente funciona perfectamente con el código:

Private Sub Comando100_Click()

Shell "xcopy /F L:\Facturas\" & "" & Me.id_facturas & "" & ".pdf L:\contabilidad\"
End Sub

________________________________________

El botón para seleccionar todos o ningún registro también funciona perfectamente con el código:

Option Compare Database

Function MarcarCampo(SióNo As Boolean)
prg = MsgBox("Seguro desea Marcar o Desmarcar todas las Casillas ", vbExclamation + vbYesNo, "Edit")
If prg = vbYes Then
Dim rst As DAO.Recordset
Set rst = Me.RecordsetClone
rst.MoveFirst
Do Until rst.EOF
rst.Edit
rst("Contabilidad_envio") = SióNo
rst.Update
rst.MoveNext
Loop
rst.Close
End If
End Function

_________________________________________

rivate Sub Comando98_Click()
If Me.Comando98.Caption = "Marcar" Then
MarcarCampo True
Me.Comando98.Caption = "Desmarcar"
ElseIf Me.Comando98.Caption = "Desmarcar" Then
MarcarCampo False
Me.Comando98.Caption = "Marcar"
End If
End Sub

Pero el botón para duplicar las facturas pdf de los registros seleccionados no me funciona. Este es el código puesto:

Private Sub Comando99_Click()
DoCmd.RunCommand acCmdSaveRecord
Dim rst As DAO.Recordset
Set rst = Me.RecordsetClone
Do Until rst.EOF
If rst("contabilidad_envio") = True Then
Shell "xcopy /F L:\Facturas\" & "" & Me.id_facturas & "" & ".pdf L:\contabilidad\"
End If
rst.MoveNext
Loop
rst.Close
Set rst = Nothing
End Sub

¿Qué tengo de corregir para que funcione?

1 Respuesta

Respuesta
1

Como poco tienes que cambiar la línea que tienes en el botón Comando99:

Shell "xcopy /F L:\Facturas\" & "" & Me.id_facturas & "" & ".pdf L:\contabilidad\"

por esta otra:

Shell "xcopy /F L:\Facturas\" & "" & rst("id_facturas") & "" & ".pdf L:\contabilidad\"

Para que en cada pasada del bucle Do While te coja el id_factura del registro en el que estás.

Un saludo.


Hola Sveinbjorn,

¿Se podría, al pegar el pdf cambiarle el nombre por ejemplo juntar los campos Empresa, proveedor y número de factura?

La idea es que quedase el nuevo pdf con el nombre:

L:\contabilidad\ + Empresa+proveedor+numero_de_factura

¿Se puede hacer? Gracias

Imagino que sí, solo has de indicar el nombre que quieres a continuación de la ruta de destino. Prueba a ver si te sale. Es igual que indicas el nombre en el archivo de origen, pero uniendo más campos.

Ya lo he conseguido. El problema es que tanto algunas empresas, proveedores o números de facturas son nombres o números compuestos con un espacio entre ambos. Esto la función para renombrarlos no la coge. Una empresa que se llama Pepito Perez, al aplicarle el código:

Shell "xcopy /F L:\Facturas\" & "" & Me.id_facturas & "" & ".pdf L:\contabilidad\" & "" & Me.Empresa & "" & ".pdf"

El sistema no dar error pero tampoco pega el pdf en su destino con el nuevo nombre. Que faena. 

Gracias de todos modos

Usa la función replace() en cada campo para cambiar los espacios por otra cosa, como un guión bajo (_) y solucionado

Si. Al final lo hice así. 

Me surgen 2 problemas relacionado con esto que no se si debo de abrir 2 nuevas preguntas o seguir aquí:

1.- Me pregunta el sistema a través de una ventana de MS Dos, para cada archivo, si la copia es de tipo file o directorio. ¿Hay manera ede evitar esta pregunta al ser siempre una copia de tipo file?

2.- Cuando hago una copia de archivos y deseo modifiar la selección del formulario ya no funciona la copia. Tengo que cerrar el formulario y volver a abrirlo. Tambien me hace esto cuando uso el botón de seleccionar todos y desmarco alguna casilla de selección. ¿Como se puede corregir?

Gracias de nuevo

Pues mira, la verdad no sé responderte a esas dos cuestiones, principalmente porque nunca uso Shell xcopy para copiar archivos, sino que uso el Objeto FileSystemObject (hay que registrar la librería “Microsoft Scripting Runtime”), algo así adaptado a tu caso:

'Estas tres lineas las colocas al principio del código
Dim fso As Scripting.FileSystemObject
Dim arch As Scripting.File 
Set fso = CreateObject("Scripting.FileSystemObject")
'Y estas dos lineas, en vez del Shell xcopy...
Set arch = fso.GetFile("L:\Facturas\"  & rst("id_facturas") &  ".pdf")
arch.Copy ("L:\contabilidad\"  & Replace(rst("Empresa")," ","_") & ".pdf"")

A ver si te sirve.

He aplicado tu código y ha eliminado el tema de tener que validar si lo que se envía es un archivo o un directorio. Sin embargo me sigue dando el problema nº2. Para una nueva selección o modificación de selección no funciona. Tengo que cerrar el formulario y volver a abrirlo.

Este es el código actual:

Private Sub Comando99_Click()
DoCmd.RunCommand acCmdSaveRecord
Dim fso As Scripting.FileSystemObject
Dim arch As Scripting.File
Set fso = CreateObject("Scripting.FileSystemObject")
Dim rst As DAO.Recordset
Set rst = Me.RecordsetClone
Do Until rst.EOF
If rst("contabilidad_envio") = True Then
Set arch = fso.GetFile("L:\Facturas\" & rst("id_facturas") & ".pdf")
arch.Copy ("L:\contabilidad\" & "" & rst("[empresa_juntar]") & "_" & "" & rst("[proveedor_juntar]") & "_" & "" & rst("[factura_juntar]") & "_" & "" & rst("[n_factura_juntar2]") & "" & ".pdf")
End If
rst.MoveNext
Loop
rst.Close
Set rst = Nothing
End Sub

Lo único que se me ocurre es que no te guarda los cambios antes de pulsar de nuevo el botón.

Prueba forzando un guardado antes de la linea Set rst = Me.RecordsetClone poniendo

DoCmd. RunCommand acCmdSaveRecord

A ver si resulta...

Me sigue haciendo lo mismo. No se si puede influir el que el formulario tome los datos de una consulta y no de la tabla.

Una vez copiados los ficheros, si los elimino y le vuelvo a dar al botón de copiar, no me los vuelvbe a copiar. Lo mismo, tengo que volver a cerrar el formulario y a abrirlo de nuevo

Sigo pensando que el problema está en que no te guarda los cambios... Prueba a cambiar la línea que te indicaba del DoCmd. RunCommand por un Me. Requery, a ver qué tal.

Sigue igual,

Para que copie los ficheros, una vez que modifico la selección, tengo que cerrar y abrir el formulario. 

He añadido en "al recibir el enfoque" y también lo he intentado añadiendo otro botón los códigos:

DoCmd.Close acForm, "Facturas_todas_contabilidad"
DoCmd.OpenForm “Facturas_todas_contabilidad”

Pero me sale el siguiente mensaje: "Se ha producido el error '2585' en tiempo de ejecución:

Ne se puede ejecutar esta acción mientras se procesa un evento de formulario o dce informe".

¿Hay alguna manera de hacerlo evitando este error?

Pues no te puedo indicar nada más, porque desconozco cómo es tu formulario y su funcionamiento, o si hay algún otro código que pueda estar interfiriendo en el proceso. Tampoco entiendo bien a qué te refieres con modificar la selección (supongo que es marcar/desmarcar casillas en el formulario), pero en cualquier caso, si guardas los cambios, el recordsetclone te tendría que coger los datos más recientes

Pero lo que está claro es que el código funcionar, funciona. Otra cosa es que sea o no el más adecuado para lo que quieres...

Hola de nuevo,

Disculpa que vuelva sobre esto. De los códigos que me ayudasteis a poner, me funcionan todos menos el comando 99. Es el que permite copiar los ficheros pdf marcados de una carpeta a otra. Lo único que creo haber cambiado es el origen de los archivos. He puesto una variable según el servidor en el cual me encuentre (Forms!FChivato.Texto8 en vez del L:\ que pusimos al principio). Estos son los códigos que tengo puestos. Cuando pulso el comando 99 solo me copia el archivo de la primera linea.

Option Compare Database

Function MarcarCampo(SióNo As Boolean)
prg = MsgBox("Seguro desea Marcar o Desmarcar todas las Casillas ", vbExclamation + vbYesNo, "Edit")
If prg = vbYes Then
Dim rst As DAO.Recordset
Set rst = Me.RecordsetClone
rst.MoveFirst
Do Until rst.EOF
rst.Edit
rst("contabilidad_envio") = SióNo
rst.Update
rst.MoveNext
Loop
rst.Close
End If
End Function

Public Function existearchivo(ruta As String) As Boolean
If Len(Dir(ruta)) > 0 Then
existearchivo = True
Else
existearchivo = False
End If
End Function

---------------------------------------------------------

Private Sub Comando100_Click() (Copiar ficheros sueltos de una carpeta a otra)
On Error Resume Next
Dim fso As Scripting.FileSystemObject
Dim arch As Scripting.File
Set fso = CreateObject("Scripting.FileSystemObject")
Set arch = fso.GetFile(Forms!FChivato.Texto8 & "Access\Facturas\" & Me.id_facturas & ".pdf")
arch.Copy (Forms!FChivato.Texto8 & "Access\contabilidad-access\" & "" & Me.empresa_juntar & "_" & "" & Me.proveedor_juntar & "_" & "" & Me.factura_juntar & "_" & "" & Me.n_factura_juntar2 & "" & ".pdf")
End Sub

-----------------------------------------------------------

Private Sub Comando37_Click() (Barrido para saber que ficheros están)

On Error Resume Next
Dim i As Integer
DoCmd.GoToRecord , , acFirst
For i = 1 To Me.Recordset.RecordCount
If IsNull([Factura]) Then
existef = ""
ElseIf existearchivo([Factura]) = True Then
existef = "Ver"
Else: existef = ""
End If
DoCmd.GoToRecord , , acNext
Next
End Sub

------------------------------------------

Private Sub Comando98_Click() (Comando "marcar/desmarcar" lineas)
If Me.Comando98.Caption = "Marcar" Then
MarcarCampo True
Me.Comando98.Caption = "Desmarcar"
ElseIf Me.Comando98.Caption = "Desmarcar" Then
MarcarCampo False
Me.Comando98.Caption = "Marcar"
End If
End Sub

--------------------------------------------

Private Sub Comando99_Click() - Copia varios ficheros entre carpetas.
On Error Resume Next
DoCmd.RunCommand acCmdSaveRecord
Dim fso As Scripting.FileSystemObject
Dim arch As Scripting.File
Set fso = CreateObject("Scripting.FileSystemObject")
Dim rst As DAO.Recordset
Me.Requery
Set rst = Me.RecordsetClone
Do Until rst.EOF
If rst("check_envio") = True Then
Set arch = fso.GetFile(Forms!FChivato.Texto8 & "Access\Facturas\" & Me.id_facturas & ".pdf")
arch.Copy (Forms!FChivato.Texto8 & "Access\contabilidad-access\" & "" & Me.empresa_juntar & "_" & "" & Me.proveedor_juntar & "_" & "" & Me.factura_juntar & "_" & "" & Me.n_factura_juntar2 & "" & ".pdf")
End If
rst.MoveNext
Loop
rst.Close
Set rst = Nothing
End Sub

-----------------------------------------

Private Sub existef_Click() (Abre el pdf)
On Error Resume Next
Dim RutaArchivo As String
RutaArchivo = Forms!FChivato.Texto8 & "Access\Facturas\" & "" & Me.id_facturas & "" & ".pdf"
Application.FollowHyperlink RutaArchivo
End Sub

--------------------------------------------

Private Sub Form_Open(Cancel As Integer)

DoCmd.Maximize
Me.Comando98.Caption = "Marcar"
End Sub

----------------------------------------

Muchas gracias

No le veo nada raro al código, por lo que poco más te puedo decir...

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas