Discussion :

[Bidule99]

Bonjour,

J'ai adapté un code d'une ancienne application qui fonctionnait sans souci. Il s'agit d'aller récupérer des résultats d'une feuille Excel, sachant que les colonnes de cette feuille ne sont pas les mêmes suivant le fichier Excel traité. J'ai une table SNDTblEvtSettings dans laquelle les colonnes de la feuille Excel chacun des paramètres sont stockées en fonction du type de fichier; ces colonnes en lettres sont transformées en nombres (par ma fonction LtrToNum).
J'ai alors une requête qui crée, pour chaque ligne de la feuille Excel, un enregistrement dans la table SNDTblRptEvts. Le code est le suivant:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
Option Explicit
Option Compare Database
'
Public BckFso As FileSystemObject
Public EmlRptAddr As String
Public EmlRptAddrNr As Integer
Public EmlRptCompany As String
Public EmlRptCompanyNr As Integer
Public EmlRptDate As String
Public EmlRptFil As String
Public EmlRptFilDate As Long
Public EmlRptFirst As String
Public EmlRptFirstNr As Integer
Public EmlRptPeoId As String
Public EmlRptPeoIdNr As Integer
Public EmlRptLast As String
Public EmlRptLastNr As Integer
Public EmlRptOrder As String
Public EmlRptPath As String
Public EmlRptReason As String
Public EmlRptReasonNr As Integer
Public II As Integer
Public MMsg As Integer
Public rS As DAO.Recordset
Public SSql As String
Public XlObj As Object
Public XlWkb As Object
Public oWSht As Variant
Private Sub Test()
'
    SSql = "DELETE [SNDTblRptEvts].SNDRptEvt FROM [SNDTblRptEvts];"
    DoCmd.RunSQL SSql
    Set rS = CurrentDb.OpenRecordset("SELECT * FROM [SNDTblEvtSettings] ORDER BY SNDEvtOrder;")
'
    Do Until rS.EOF
'
        EmlRptOrder = rS.Fields("SNDEvtOrder").Value
        If EmlRptOrder > "T" Then GoTo FmlB000BtnE10Lbl7000
'
        EmlRptFil = rS.Fields("SNDEvtName").Value
        MMsg = MsgBox("Do you want to process the " & EmlRptFil & " Report?", 276, _
                       "!!!!!     Report to be processed     !!!!!")
        If MMsg = 7 Then GoTo FmlB000BtnE10Lbl3000
'
        EmlRptOrder = ""
        EmlRptPath = ""
        EmlRptLast = ""
        EmlRptFirst = ""
        EmlRptPeoId = ""
        EmlRptCompany = ""
        EmlRptAddr = ""
        EmlRptDate = ""
        EmlRptReason = ""
'
        EmlRptPath = rS.Fields("SNDEvtPath").Value
        Set BckFso = CreateObject("Scripting.FileSystemObject")
        EmlRptFilDate = BckFso.GetFile(EmlRptPath).DateCreated
        EmlRptLast = rS.Fields("SNDEvtColLast").Value
        EmlRptFirst = rS.Fields("SNDEvtColFirst").Value
        EmlRptPeoId = rS.Fields("SNDEvtColPeoIden").Value
        EmlRptCompany = rS.Fields("SNDEvtColComp").Value
        EmlRptAddr = rS.Fields("SNDEvtColAddr").Value
        EmlRptDate = rS.Fields("SNDEvtColDate").Value
        EmlRptReason = rS.Fields("SNDEvtColReason").Value
'
        EmlRptLastNr = LtrToNum(EmlRptLast)
        EmlRptFirstNr = LtrToNum(EmlRptFirst)
        EmlRptPeoIdNr = LtrToNum(EmlRptPeoId)
        EmlRptCompanyNr = LtrToNum(EmlRptCompany)
        EmlRptAddrNr = LtrToNum(EmlRptAddr)
        EmlRptReasonNr = LtrToNum(EmlRptReason)
'
        Set XlObj = CreateObject("Excel.Application")
        Set XlWkb = XlObj.Workbooks.Open(EmlRptPath)
        Set oWSht = XlWkb.Worksheets("Sheet1")
'
        II = 2
        While oWSht.Range("A" & II).Value <> ""
            SSql = "INSERT INTO [SNDTblRptEvts] ([SNDRptEvt], [SNDRptLast], [SNDRptFirst], [SNDRptCompany], [SNDRptAddr], [SNDRptReason], [SNDRptDate]) Values (" & Chr(34) & EmlRptTyp & Chr(34) & "," & Chr(34) & _
                        oWSht.Cells(IndI, EmlRptLastNr) & Chr(34) & "," & Chr(34) & oWSht.Cells(IndI, EmlRptFirstNr) & Chr(34) & "," & Chr(34) & oWSht.Cells(IndI, EmlRptCompanyNr) & Chr(34) & "," & Chr(34) & _
                        oWSht.Cells(IndI, EmlRptAddrNr) & Chr(34) & "," & Chr(34) & oWSht.Cells(IndI, EmlRptReasonNr) & Chr(34) & "," & EmlRptFilDate & ")"
            DoCmd.RunSQL SSql
            II = II + 1
        Wend
'
        XlObj.Quit
        Set XlObj = Nothing
'
End Sub
Public Function LtrToNum(Ltr As String) As Integer
'
'   To obtain the number of a spreadsheet column from its name in letters
'   LIMITED to 2 letters colum names
'
    If Len(Ltr) = 1 Then
        LtrToNum = Asc(UCase(Ltr)) - 64
    Else
        LtrToNum = (Asc(UCase(Left(Ltr, 1))) - 64) * 26 + Asc(UCase(Right(Ltr, 1))) - 64
    End If
'
End Function

A l'exécution, j'ai une erreur 1004



sur la ligne 79, c'est-à-dire lors de la création de la requête avant son exécution.

Je tourne depuis pas mal de temps pour trouver la raison, mais sans succès.
J'apprécierais donc beaucoup vos lumières.

Merci d'avance.

.

[Jean-Philippe André]

Salut,

le mieux serait de tester chacune de tes valeurs pour voir laquelle pose vraiment probleme

Essaie avec

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Debug.Print EmlRptTyp 
Debug.Print oWSht.Cells(IndI, EmlRptLastNr)
Debug.Print oWSht.Cells(IndI, EmlRptFirstNr)
Debug.Print oWSht.Cells(IndI, EmlRptCompanyNr)
Debug.Print oWSht.Cells(IndI, EmlRptAddrNr)
Debug.Print oWSht.Cells(IndI, EmlRptReasonNr)

dans la liste des raisons possibles selon moi :
-une de tes variables EmlRpt part en sucette (ne contient pas de valeur numérique ?)
- une de tes cellules contient une erreur
- tu devrais utiliser Cells().value pour éviter les erreurs involontaires

[Bidule99]

Merci, j'aurais effectivement dû tester les variables.
En fait, j'avais une double erreur:
- dans la requête SSql, EmlRptTyp doit être EmlRptFil, et
- le numéro de ligne doit être II et non pas IndI qui n'est d'ailleurs pas déclaré (pas pris par l'Option Explicit).

Le confinement ne me va pas bien!!!

En tout cas, merci beaucoup et bon week-end.

Je marque le sujet comme Résolu.

.