Copier Excel pour coller dans table Access

Question

Bonjour,

J'aimerais créer une macro qui permet de copier les données d'une feuille Excel dans une table Access juste en cliquant sur un bouton (dans feuille excel).

Les données dans le fichier Excel ont les même noms de champs que les données dans la table Access.

Quelqu'un pourrait m'aider, je suis débutante en VBA ?

Merci

c148270 · Answer

Bonjour
Celà ne correspond pas exactement à la demande puisque je ne charge qu'une colonne et que j'appelle le champ F1.
Donc à retravailler

Function Chargement()
    Dim cat As New ADOX.Catalog
    Dim tbl As ADOX.Tables
    Dim cnn As New Connection
    Dim cmd As New ADODB.Command
    Nomfichier = ActiveWorkbook.Name
    Set Fichier = Workbooks(Nomfichier)
    Fichier.Activate
    chemin = ActiveWorkbook.FullName
    Nomfichier = ActiveWorkbook.Name
    Position = InStrRev(Nomfichier, ".", , vbTextCompare)
    nom = Left(Nomfichier, Position - 1)
With Fichier
    .Activate
    On Error GoTo errxls
    Application.DisplayAlerts = False
    Set newfeuille = Sheets.Add
suitexls:
    With newfeuille
        .Name = "act"
    End With
    Application.DisplayAlerts = True
retval = Application.GetOpenFilename("Microsoft Access(*.mdb),*.mdb)", , "Emplacement de la base de données")
    If retval = False Then
        MsgBox "Exécution annulée"
        Exit Function
    End If
    sourcetablestr = "tfichierxls"
    ConnectStr = "Provider=microsoft.jet.oledb.4.0;Data Source=" & retval
    cnn.Open ConnectStr
    Set cat.ActiveConnection = cnn
    Set tbl = cat.Tables
    On Error GoTo errconnexion
    tbl.Delete (sourcetablestr)
suite:
    Set cmd.ActiveConnection = cnn
    cmd.CommandText = "SELECT """ & chemin & """ AS fichierxls INTO " & sourcetablestr & ";"
    cmd.Execute
    tbl.Delete ("tgozactivitechoisixls")
    Set freference = Sheets("Référentiel")
    With freference
        nombreligne = .Range("c65536").End(xlUp).Row
        Range("c1").CurrentRegion.Select
        ligne = 1
oncommence:
        activite = .Cells(ligne, 3)
        If IsEmpty(activite) Then
            ligne = ligne + 1
            GoTo oncommence
        End If
        cmd.CommandText = "SELECT """ & activite & """ as F1 INTO tgozactivitechoisixls;"
        cmd.Execute
        Do While ligne <= nombreligne
            activite = .Cells(ligne, 3)
            If IsEmpty(activite) Then GoTo onpasse
            cmd.CommandText = "INSERT INTO tgozactivitechoisixls ( F1 )SELECT """ & activite & """;"
            cmd.Execute
onpasse:
            ligne = ligne + 1
        Loop
    End With
    cnn.Close

End Function

Bon courage et bonne journée

yadla133 · Answer

Bonjour,

Je viens de tenter de comprendre un peu ce code. J'ai une petite question. La table existante est supprimée, puis ensuite recréée pour etre remplie c'est bien ça ? Parce que lors de la suppression, il me semble que les relations de la table avec les autres tables encore existantes sont également supprimées... Je me trompe surement... ???

Je n'ai pas essayé ce code, mais je m'en suis sortie quand meme, en bidouillant avec des boucles de copie d'une cellule excel dans un champs access... Ca marche :)

c148270 · Answer

En effet je supprime la table.
S'il y avait des relations elles auraient été supprimées.
J'aurai pu simplement la vider.
Ma table est simple: un champ, pas de relation.

Copier Excel pour coller dans table Access

3 réponses

Votre réponse

Discussions similaires