Error 2501 access 2013 la acción RunSql se cancelo

En la función de más abajo quiero grabar en una tabla "Listas_Ficheros", la dirección de los archivos .mp3 que contenga una carpeta cuya dirección esta guardada en Carpeta_Album. Si solo grabo una lista, lo hace todo correctamente pero, si la tabla Listas_Ficheros contiene algún registro, me sale este error del titulo.

La tabla Listas_reproducción contiene un solo campo que es el nombre de la lista a grabar.

La tabla Listas_Ficheros contiene tres campos (Nombre_Lista, Direccion_Fichero, Orden). Los dos primeros son la clave principal de la tabla.

Por favor, ¿me podéis ayudar a encontrar por que se produce el error?

Gracias.

'----------------------------- GRABA LISTA DESDE ALBUM COMPLETO------------------------
Private Sub ListaGraba_Click()
Dim xFSO As Object
Dim xFolder As Object
Dim xFile As Object
Dim xFiDialog As FileDialog
Dim xPath As String, todo As String, exten As String
Dim i As Integer

RutaGraba = rutaCarpeta("Listas") & NombreLista & "\"

xPath = Me.Carpeta_Album
If xPath = "" Then Exit Sub
Set xFSO = CreateObject("Scripting.FileSystemObject")
Set xFolder = xFSO.GetFolder(xPath)
' En nc guardo el numero de canciones que he grabado ya en la lista, para seguir con la secuencia en caso de que se grabe más de un album
i = nc
For Each xFile In xFolder.Files
i = i + 1
nc = i
archivoC = Left(xFile.Name, InStrRev(xFile.Name, ".") - 1) & "." & Mid(xFile.Name, InStrRev(xFile.Name, ".") + 1)
Direccion = Me.Carpeta_Album & archivoC
numcar = InStrRev(archivoC, ".") ' miramos la posicion de la ultima \ del archorigen. Lo que haya a la derecha debe ser el nombre de la canción
exten = Right(archivoC, Len(archivoC) - numcar) ' Extraemos los x caracteres desde la ultima barra \
If exten = "mp3" Then
DoCmd.RunSQL "insert into [Listas_Ficheros] (Nombre_Lista, Direccion_Fichero, Orden) VALUES('" & NombreLista & "','" & Direccion & "','" & nc & "')"
End If
Next

End Sub

Respuesta

Pruebe con este código válido antes para evitar duplicados.

Private Sub ListaGraba_Click()
Dim xFSO As Object
Dim xFolder As Object
Dim xFile As Object
Dim xPath As String, todo As String, exten As String
Dim i As Integer
Dim archivoC As String, Direccion As String, numcar As Integer
Dim nombreEsc As String, direccionEsc As String
RutaGraba = rutaCarpeta("Listas") & NombreLista & "\"
xPath = Me.Carpeta_Album
If xPath = "" Then Exit Sub
Set xFSO = CreateObject("Scripting.FileSystemObject")
Set xFolder = xFSO.GetFolder(xPath)
i = nc
For Each xFile In xFolder.Files
    i = i + 1
    nc = i
    archivoC = Left(xFile.Name, InStrRev(xFile.Name, ".") - 1) & "." & Mid(xFile.Name, InStrRev(xFile.Name, ".") + 1)
    Direccion = Me.Carpeta_Album & archivoC
    numcar = InStrRev(archivoC, ".")
    exten = Right(archivoC, Len(archivoC) - numcar)
    If exten = "mp3" Then
        nombreEsc = Replace(NombreLista, "'", "''")
        direccionEsc = Replace(Direccion, "'", "''")
        If DCount("*", "Listas_Ficheros", "Nombre_Lista='" & nombreEsc & "' AND Direccion_Fichero='" & direccionEsc & "'") = 0 Then
            DoCmd.RunSQL "INSERT INTO [Listas_Ficheros] (Nombre_Lista, Direccion_Fichero, Orden) VALUES('" & nombreEsc & "','" & direccionEsc & "','" & nc & "')"
        End If
    End If
Next
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas