Problema al ejecutar comando en Access
Eh podido avanzar con mi BD para crear informe con imágenes buscando en la red logre hacer algo me funciona con la primera imagen, se crea una carpeta OT, selecciono imagen desde una carpeta "X", copio imagen a carpeta nueva con numero de orden, pero al hacer lo mismo en la segunda imagen, la tercera y etc., "Error Se ha producido el error Nº: 75 Error de acceso a la ruta o el archivo". Lo que tratado de hacer es validar si ya la carpeta existe, porque siempre me manda el mensaje "carpeta destino creada" y la foto que copia a la carpeta que cree, no puedo ponerle el número de OT y un número correlativo ya que son más de 20 imágenes que debo registrar como mínimo. No eh pidodo agregar el codigo fuente, me pueden indicar a que correo le envio la BD.
Por lo que menciona, el error 75 en VBA generalmente ocurre porque:
La carpeta ya existe y el código intenta crearla de nuevo sin validarlo correctamente.
El archivo que intenta copiar ya está en uso o bloqueado.
No tiene permisos suficientes para escribir en la carpeta de destino.
Para solucionarlo, podría hacer lo siguiente en VBA antes de copiar la imagen:
Verificar si la carpeta ya existe antes de crearla.
Asegurar que la imagen de origen no esté en uso.
Usar un número correlativo único al copiar las imágenes.
Si puede enseñar el código que usa podría darle una respuesta más completa
Hola Don Eduardo, quise agregar el código en la pregunta original, pero el sistema no me dejaba, ahora lo pude adjuntar
'*** AQUI BUSCO LA IMAGEN 1 DE 20 Private Sub Imagen1_DblClick(Cancel As Integer) On Error GoTo Sol_err Dim miRuta As String Dim miCarpeta As Variant Dim miNewRuta As String Dim miArchivo As String Dim My As String On Error GoTo CapturarError Dim fd As FileDialog Set fd = Application.FileDialog(msoFileDialogFilePicker) Dim RutaCarpeta As String 'Aqui intento validar si ya existe la carpeta RutaCarpeta = "\Tools\OTClientes\Informes\" If Dir(RutaCarpeta, vbDirectory) = "" Then MsgBox "La carpeta no existe y se creará", , "Atención" MkDir RutaCarpeta End If Dim SeleccionaElemento As Variant '----------------------------------------- miRuta = Application.CurrentProject.Path & "\Tools\OTClientes\Informes\" miCarpeta = Me.NombreCarpeta miArchivo = Me.OT & "F_1" & ".jpg" 'Aqui indico en nombre de la foto, su extención, pero no se como ponerle numero correlativo, ya que son mas imagenes 'MsgBox miCarpeta & "- " & miArchivo '-------------------------- MsgBox "Carpeta destino creada" miNewRuta = miRuta & miCarpeta MkDir miNewRuta With fd .Filters.Clear .AllowMultiSelect = False .InitialFileName = CurrentProject.Path & "\Tools\OTClientes\Informes\ImagenesInforme" .Filters.Add "Todos los Archivos", "*.*" .Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.BMP", 1 If .Show = -1 Then 'Aquí ejecuto este comando para que me copie o si es posible mover la imagen de la carpeta origen a la destino creada FileCopy .SelectedItems(1), miNewRuta & "\" & miArchivo Me.RutaInicial1 = miNewRuta & "\" & miArchivo DoCmd.RunCommand acCmdSaveRecord 'Aqui para que me guarde la ruta de la imagen sin egrosar la base dato For Each SeleccionaElemento In .SelectedItems Me.IdPhoto1 = Mid(SeleccionaElemento, (IIf(InStrRev(SeleccionaElemento, ":") > InStrRev(SeleccionaElemento, "\"), InStrRev(SeleccionaElemento, ":"), InStrRev(SeleccionaElemento, "\")) + 1)) Me.Imagen1.Picture = Dir(SeleccionaElemento) DoCmd.RunCommand acCmdRefresh Next SeleccionaElemento End If MsgBox "Archivo adjunto con exito", vbInformation, "Aviso.." End With Set fd = Nothing SeguirPorAqui: Exit Sub CapturarError: If Err.Number = 2220 Then MsgBox "¡¡Debes seleccionar una imagen desde la carpeta Imagenes Informe!!", vbInformation, "Aviso.." Else End If MsgBox "Se ha producido el error Nº: " & Err.Number & " " & Err.Description, vbInformation, "Error" Resume SeguirPorAqui Continua_error_75: 'El error 75 aparece cuando la carpeta ya exite On Error Resume Next '------------------------------- Salida: Exit Sub Sol_err: If Err.Number = 75 Then GoTo Continua_error_75 Else MsgBox "Se ha producido el error " & Err.Number & " -" & Err.Description Resume Salida End If End Sub --------------------------------------------- '** AQUI AL INICIAR EL FORMULARIO ME VALIDA LA FOTO ASOCIADA, PERO NO SE COMO DEFINIRLE AL PACTH QUE EL NOMBRE DE LA CARPETA SE LA INDICO EN UN TEXTBOX Private Sub Form_Load() DoCmd.GoToRecord , , acNewRec Call AgregarFoto End Sub Function AgregarFoto() On Error GoTo CapturarError If Me.NewRecord Then 'Primera imagen Dim NombreImagen1 As Variant Dim RutaImagen1 As String Me.Imagen1.Picture = "" RutaImagen1 = Application.CurrentProject.Path & "\Tools\OTClientes\Informes\ImagenesInforme\SinFoto.jpg" Me.Imagen1.Picture = RutaImagen1 Me.Refresh Else If Me.IdPhoto1.Value = "" Or IsNull(Me.IdPhoto1.Value) Or Me.IdPhoto1.Value = "SinFoto.jpg" Then Me.Imagen1.Picture = "" NombreImagen1 = Me.IdPhoto1.Value RutaImagen1 = Application.CurrentProject.Path & "\Tools\OTClientes\Informes\ImagenesInforme\SinFoto.jpg" Me.Imagen1.Picture = RutaImagen1 Me.Refresh Else NombreImagen1 = Me.IdPhoto1.Value RutaImagen1 = Application.CurrentProject.Path & "\Tools\OTClientes\Informes\" & Me.NombreCarpeta \" & NombreImagen1 Me.Imagen1.Picture = RutaImagen1 Me.Imagen1.Requery Me.Refresh End If End If '---------------------------------------------------------------------------------------------------------------------- If Me.NewRecord Then 'Segunda Imagen Dim NombreImagen2 As Variant Dim RutaImagen2 As String Me.Imagen2.Picture = "" RutaImagen2 = Application.CurrentProject.Path & "\Tools\OTClientes\Informes\ImagenesInforme\SinFoto.jpg" Me.Imagen2.Picture = RutaImagen2 Me.Refresh Else If Me.IdPhoto2.Value = "" Or IsNull(Me.IdPhoto2.Value) Or Me.IdPhoto2.Value = "SinFoto.jpg" Then Me.Imagen2.Picture = "" NombreImagen2 = Me.IdPhoto2.Value RutaImagen2 = Application.CurrentProject.Path & "\Tools\OTClientes\Informes\ImagenesInforme\SinFoto.jpg" Me.Imagen2.Picture = RutaImagen2 Me.Refresh Else NombreImagen2 = Me.IdPhoto2.Value RutaImagen2 = Application.CurrentProject.Path & "\Tools\OTClientes\Informes\" & Me.NombreCarpeta \" & NombreImagen2 Me.Imagen2.Picture = RutaImagen2 Me.Imagen2.Requery Me.Refresh End If End If '---------------------------------------------------------------------------------------------------------------------
Posibles problemas en su código y soluciones
Validación incorrecta de la existencia de la carpeta
Dir(RutaCarpeta, vbDirectory) = "" no siempre es confiable para verificar si una carpeta existe. Es mejor usar Len(Dir(RutaCarpeta, vbDirectory)) = 0.
Intenta crear la carpeta de destino cada vez
Primero crea miNewRuta = miRuta & miCarpeta
Luego usa MkDir miNewRuta sin verificar si ya existe
No se genera correctamente un número correlativo para las imágenes
Todas las imágenes están siendo guardadas con el mismo nombre (F_1.jpg).
Para evitar sobreescrituras, necesita agregar un número incremental.
Private Sub Imagen1_DblClick(Cancel As Integer) On Error GoTo CapturarError Dim miRuta As String Dim miCarpeta As String Dim miNewRuta As String Dim miArchivo As String Dim fd As FileDialog Dim RutaCarpeta As String Dim i As Integer Dim NombreBase As String Dim NombreFinal As String ' Definir la ruta base de informes RutaCarpeta = Application.CurrentProject.Path & "\Tools\OTClientes\Informes\" ' Verificar si la carpeta base existe If Len(Dir(RutaCarpeta, vbDirectory)) = 0 Then MkDir RutaCarpeta MsgBox "Carpeta base creada: " & RutaCarpeta, vbInformation, "Atención" End If ' Definir carpeta específica para la OT miCarpeta = Me.NombreCarpeta miNewRuta = RutaCarpeta & miCarpeta ' Verificar si la carpeta específica de la OT existe If Len(Dir(miNewRuta, vbDirectory)) = 0 Then MkDir miNewRuta MsgBox "Carpeta creada: " & miNewRuta, vbInformation, "Atención" End If ' Configurar cuadro de diálogo para seleccionar la imagen Set fd = Application.FileDialog(msoFileDialogFilePicker) With fd .Filters.Clear .AllowMultiSelect = False .InitialFileName = Application.CurrentProject.Path & "\Tools\OTClientes\Informes\ImagenesInforme" .Filters.Add "Imágenes", "*.gif; *.jpg; *.jpeg; *.bmp", 1 If .Show = -1 Then ' Obtener el nombre base de la imagen sin extensión NombreBase = Me.OT & "_F_" ' Buscar el siguiente número disponible i = 1 Do While Dir(miNewRuta & "\" & NombreBase & i & ".jpg") <> "" i = i + 1 Loop ' Definir el nombre final del archivo con número correlativo NombreFinal = NombreBase & i & ".jpg" ' Copiar la imagen seleccionada con el nuevo nombre FileCopy .SelectedItems(1), miNewRuta & "\" & NombreFinal Me.RutaInicial1 = miNewRuta & "\" & NombreFinal Me.IdPhoto1 = NombreFinal Me.Imagen1.Picture = Me.RutaInicial1 DoCmd.RunCommand acCmdSaveRecord DoCmd.RunCommand acCmdRefresh MsgBox "Imagen guardada con éxito: " & NombreFinal, vbInformation, "Éxito" End If End With Set fd = Nothing Exit Sub CapturarError: MsgBox "Se ha producido el error Nº: " & Err.Number & " - " & Err.Description, vbExclamation, "Error" End Sub
Explicación de las mejoras
Verifica correctamente si la carpeta ya existe
Usa Len(Dir(RutaCarpeta, vbDirectory)) = 0 en lugar de Dir(...) = "" para evitar errores.
Evita errores al crear la carpeta OT
Solo crea la carpeta si no existe.
Genera un número correlativo para cada imagen
Usa Dir() en un bucle Do While para encontrar el siguiente número disponible.
Corrige la asignación del nombre de la imagen
Evita que todas se llamen F_1.jpg, asegurando que sean únicas (F_1.jpg, F_2.jpg, etc.).
Refresca correctamente la imagen en el formulario
Me.Imagen1.Picture = Me.RutaInicial1 permite que la imagen se muestre inmediatamente
1 respuesta más de otro experto
Para cambiar el nombre de un archivo, se puede utilizar el comando NAME desde VBA la sintaxis es:
Name "Ruta+nombre_archivo" As "Ruta+Nuevo_Nombre"
Si se dispone de una variable (para generar una serie incremental) solo hay que combinarla con el nombre actual para obtener el final deseado.
Con la función DIR se puede conocer si existe la ruta y también si existe en esa ruta el archivo para garantizar que no se producen errores (por ejemplo solapamientos)