Erreur lors de l'importation Excel via VBA Access
Bonsoir,
Je souhaite ajouter un enregistrement à une table access "tableToAddRecordto", les champs de cet enregistrement se situant dans un fichier excel et plus précisément dans
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
| Sub tableToAddRecord(tableToAddRecordto As String, excelFilePath As String, xlRangeName As String)
On Error GoTo ReadFromExcelUsingArray_Err
' Declare variables
Dim cnn1 As New ADODB.Connection
Dim cnn2 As New ADODB.Connection
Dim rst1 As New ADODB.Recordset
Dim rst2 As New ADODB.Recordset
Dim i As Integer
Dim x As Integer
Dim strSQL As String
Dim arrData() As Variant
'-----------------------------------------------------
' Open the connection to Excel then open the recordset
'-----------------------------------------------------
cnn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & excelFilePath & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes"";"
rst1.Open "SELECT * FROM [" & xlRangeName & "];", cnn1, adOpenStatic, adLockReadOnly
'-----------------------------------------------------
' Read the Excel recordset into a variant array
'-----------------------------------------------------
arrData = rst1.GetRows(rst1.RecordCount)
'-----------------------------------------------------
' Open the new table as a recordset
'-----------------------------------------------------
Set cnn2 = CurrentProject.Connection
rst2.Open "SELECT * FROM " & tableToAddRecordto, cnn2, adOpenDynamic, adLockOptimistic
'-----------------------------------------------------
' Write records from variant array into table
'-----------------------------------------------------
For i = 0 To rst1.RecordCount - 1
With rst2
.AddNew
For x = 0 To rst1.Fields.Count - 1
.Fields(x).Value = arrData(x, i)
Next x
.Update
End With
Next i
' Tidy up
Application.RefreshDatabaseWindow
ReadFromExcelUsingArray_Exit:
On Error Resume Next
rst1.Close
rst2.Close
cnn1.Close
cnn2.Close
Set rst1 = Nothing
Set rst2 = Nothing
Set cnn1 = Nothing
Set cnn2 = Nothing
Exit Sub
ReadFromExcelUsingArray_Err:
MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "Error!"
Resume ReadFromExcelUsingArray_Exit
End Sub |
J'obtiens une erreur disant que mon rRangeName n'existe pas et pourtant j'ai bien un range nommé ainsi dans mon fichier excel..
Ai-je oublier quelque chose?
Merci pour vos idées !
