Importation d'un tableau Excel vers un tableau Access (VBA)

Version imprimable

Bonjour à tous,

Comme l'indique le titre je souhaiterais insérer des données d'un tableau Excel vers un tableau Access existant. Cela me permettrait de mettre à jour un statut qui vérifierait si la ligne existe déjà dans mon tableau Access (ligne qui n'existe pas sur ma partie Excel) (doublon si oui et importé sinon).

Voici l'ébauche de mon code, je n'arrive pas à savoir comment passer d'Excel à Access pour la partie où je teste :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
 
Private Sub CmdImpJtrac_Click()
    Dim dialog As FileDialog
    Dim fso As New Scripting.FileSystemObject
    Dim Path As String
 
    'Open a Windows window to pick a file
    Set dialog = Application.FileDialog(msoFileDialogFilePicker)
    With dialog
    .AllowMultiSelect = False
    .Show
     fileJtrac = .SelectedItems.Item(1)
    End With
 
     RepJtrac.Caption = fileJtrac
 
    Dim xls As Excel.Application
    Set xls = CreateObject("Excel.Application")
    xls.Workbooks.Open fileJtrac
    xls.Visible = True
    Dim i As Integer
    i = 2
    While Not IsEmpty(Cells(i, 1))
         If Not IsNull(DLookup("[Statut]", "Tableau", "[Identifiant]='" & Cells(i, 1).Value & "' AND [LastUpdate]= '" & Cells(i, 14).Value & "' ")) Then
            oRst.Fields("Statut").Value = "Doublon"
        Else
            oRst.Fields("Statut").Value = "Importé"
        End If
    Wend
 
End Sub

Merci

04/08/2016, 08h15
Invité

Bonjour,
Dans un script Sql, il est possible d'effectuer des jointures externe???

Ce sont des requête qui pointent sur une base de données ce trouvant à l'extérieur de la base de données active.

Cette jointure peut ce faire sur une base d'un autre type Access -> Excel.

Update tableAccess Left join (select * from [Onglet$] in 'C:\Fichier.xlsx' 'Dirver') as frm on frm.identifiant =tableAccess.identifiant set [Statut]=Iif(frm.identifiant is null,'Ok','Ko')http://www.developpez.net/forums/d15...a/#post8696453 set

Bonjour,

Merci de ton aide mais je ne suis pas assez à l'aise en SQL
Finalement, j'ai opté pour TransferSpreasheet :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
 
 
Dim dialog As FileDialog
Dim fso As New Scripting.FileSystemObject
Dim Path As String
Dim filePick As String
 
'Open a Windows window to pick a file
Set dialog = Application.FileDialog(msoFileDialogFilePicker)
With dialog
    .AllowMultiSelect = False
    .Show
     filePick = .SelectedItems.Item(1)
End With
 
Dim objExcel As Object 'Excel.Application
Dim objWorkbook As Object 'Excel.Workbook
Dim objWorksheet As Object 'Worksheet
Dim strXlFileName As String 'Excel Workbook name
Dim strWorksheetName As String 'Excel Worksheet name
Dim objCell As Object 'Last used cell in column
Dim strUsedRange As String 'Used range
 
 
'Assign Path and filename of XL file to variable
strXlFileName = filePick
 
'Assign Excel application to a variable
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False 'Can be visible or not visible
 
'Open the Excel Workbook
Set objWorkbook = objExcel.Workbooks.Open(strXlFileName)
 
'Assign required worksheet to a variable
With objWorkbook
    Set objWorksheet = .Worksheets(2)
End With
 
With objWorksheet
    'Assign worksheet name to a string variable
    strWorksheetName = .Name
    'Find last used cell in Column A
    Set objCell = .Cells(.Rows.Count, "A").End(xlUp)
End With
 
'Assign used range to a string variable.
'.Address(0,0) returns A1:F10 type address.
'Absolute address ($A$1:$F$1000) does not work in
'DoCmd.TransferSpreadsheet.....etc.
strUsedRange = objWorksheet.UsedRange.Address(0, 0)
'Turn off/Close in reverse order to setting/opening.
Set objCell = Nothing
Set objWorksheet = Nothing
 
'SaveChanges = False suppresses save message
objWorkbook.Close SaveChanges:=True
Set objWorkbook = Nothing
objExcel.Quit
Set objExcel = Nothing
 
DoCmd.RunSQL "delete * from TEMP"
 
DoCmd.TransferSpreadsheet acImport, , "TEMP",filePick, True, strWorksheetName & "!" & strUsedRange

Par contre, maintenant je dois importer ma table TEMP vers ma TABLEFINALE avec ces conditions :
- si la ligne importée existe déjà (on teste 2 champs), à la colonne "suivi" elle prend "doublon"
- si la ligne importée existe déjà (un champ identique l'autre différent), à la colonne "suivi" l'ancienne prend "ancien" et la nouvelle "importé"
- si la ligne importée n'existe pas, à la colonne suivi elle prend "importé"

Merci