Bonjour à tous,

je viens réclamer de l'aide parce que la je m'arrache les cheveux, je ne comprend plus rien ...

il y a 6 semaines j'ai commencer un programme de gestion de productivite pour ma boite.

pour ce faire je doit integre des données dans une base access, ces données sont contenue dans un fichier excel jusque la tous va bien,

mon programme est presque fini je suis sur la partie habillage/design/decoration (le plus chiant en faite) et en faisant un test ce matin j'obtient une erreur "Exception from HRESULT: 0x800401A8".

j'ai commencer a chercher sur internet et on parle de problème d'acces au fichier excel, le problèmes c'est que ce message est apparut ce matin !
et sa fait 5 semaines que je travaille avec le même fichier excel et que je n'aie jamais eu se message d'erreur ...
je suis complètement largué, je ne comprend pas comment une erreur peut apparaitre en 1 nuit alors que j'utilise le même fichier depuis des semaines ... et au niveau du code je n'aie rajouter qu'une condition en plus ...

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
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
 
'voici les imports rien de bien special'
Imports System.Data
Imports System.Data.OleDb
Imports System.IO.File
Imports Microsoft.VisualBasic
Imports Microsoft.Office
Imports Microsoft.Office.Interop
Imports Microsoft.Office.Interop.Excel
 
Public Class FImport
 
    Dim Choix As String
    Dim Chemin As String
    Dim TextSql As String
 
    Private Sub BImport_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BImportRamasse.Click
        OpenFileDialog1.ShowDialog()
    End Sub
 
    Sub Importation()
 
        'variables pour excel'
        Dim appXls As Application
        Dim sheetXls As Excel.Worksheet
        'variable autres'
        Dim x As Integer
        Dim CodeSecteur As Integer
        Dim CodePVT As Integer
        Dim CodeUser As Integer
        Dim NomUser As String
        Dim jDebutPvt, mDebutPvt, yDebutPvt As Integer
        Dim Temps As Integer
        Dim QttRamasser, QttPrelevee, QttRuptee As Integer
        Dim Productivite As Integer
 
        Label1.Text = 0
        Dim a As Integer = Me.Width
        Dim b As Integer = Label1.Width
        Dim c As Integer = (a - b) / 2
        Label1.Left = c
 
' CODE RAJOUTER CE MATIN'
 
        If (Chemin.ToLower().IndexOf("ventilation") > -1) Then
            Choix = "Ventilation"
        ElseIf (Chemin.ToLower().IndexOf("ramasse") > -1) Then
            Choix = "Ramasse"
        Else
            MsgBox("ERREUR - Fichier inconnu, impossible de reconnaitre le fichier", MsgBoxStyle.OkOnly, "ERREUR")
        End If
 
'FIN DU CODE RAJOUTER CE MATIN'
 
        Select Case Choix
            Case "Ramasse"
                appXls = New Application   'ouverture d'excel 
                appXls.Visible = False 'on affiche la fenetre d'excel
                appXls.Workbooks.Open(Chemin) 'ouverture du fichier excel
                sheetXls = CType(appXls.ActiveWorkbook.Worksheets("Sheet1"), Worksheet) 'on selectionne la page "sheet1"
 
                x = 2
                Do While Trim(sheetXls.Range("A" & x).Value) <> "" '<----- LIGNE AVEC MESSAGE D'ERREUR
                    CodeSecteur = 0
                    CodePVT = 0
                    CodeUser = 0
                    NomUser = ""
                    Temps = 0
                    QttRamasser = 0
                    Productivite = 0
 
                    CodeSecteur = Trim(sheetXls.Range("A" & x).Value)
                    CodePVT = Trim(sheetXls.Range("B" & x).Value)
                    CodeUser = Trim(sheetXls.Range("C" & x).Value)
                    NomUser = Trim(sheetXls.Range("D" & x).Value)
                    jDebutPvt = Strings.Left(sheetXls.Range("E" & x).Value, 2)
                    mDebutPvt = Mid(sheetXls.Range("E" & x).Value, 4, 2)
                    yDebutPvt = Mid(sheetXls.Range("E" & x).Value, 7, 4)
                    Temps = sheetXls.Range("G" & x).Value
                    QttRamasser = sheetXls.Range("H" & x).Value
                    QttRuptee = sheetXls.Range("I" & x).Value
                    Productivite = sheetXls.Range("J" & x).Value
 
                    TextSql = "insert into ramasse (codesecteur, codepvt, codeuser, nomuser, jdebutpvt, mdebutpvt, ydebutpvt, temp, qttramasser, qttruptee, productivite) values ('" & CodeSecteur & "', '" & CodePVT & "', '" & CodeUser & "', '" & NomUser & "', " & jDebutPvt & ", " & mDebutPvt & ", " & yDebutPvt & ", " & Temps & ", '" & QttRamasser & "', '" & QttRuptee & "', '" & Productivite & "')"
 
                    'On Error GoTo Affiche
                    Dim CmdValeur As New OleDbCommand(TextSql, DBAccess)
                    CmdValeur.ExecuteNonQuery()
                    Label1.Text = x
                    x = x + 1
                    appXls.Quit()
                Loop
 
            Case "Ventilation"
                appXls = New Application   'ouverture d'excel 
                appXls.Visible = False 'on affiche la fenetre d'excel
                appXls.Workbooks.Open(Chemin) 'ouverture du fichier excel
                sheetXls = CType(appXls.ActiveWorkbook.Worksheets("Sheet1"), Worksheet) 'on selectionne la page "sheet1"
 
                x = 2
                Do While Trim(sheetXls.Range("A" & x).Value) <> "" '<----- LIGNE AVEC MESSAGE D'ERREUR
 
                    CodeUser = 0
                    NomUser = ""
                    Temps = 0
                    QttPrelevee = 0
                    QttRuptee = 0
                    Productivite = 0
 
                    CodeUser = Trim(sheetXls.Range("A" & x).Value)
                    NomUser = Trim(sheetXls.Range("B" & x).Value)
                    jDebutPvt = Strings.Left(sheetXls.Range("C" & x).Value, 2)
                    mDebutPvt = Mid(sheetXls.Range("C" & x).Value, 4, 2)
                    yDebutPvt = Mid(sheetXls.Range("C" & x).Value, 7, 4)
                    Temps = sheetXls.Range("E" & x).Value
                    QttPrelevee = sheetXls.Range("F" & x).Value
                    QttRuptee = sheetXls.Range("G" & x).Value
                    Productivite = sheetXls.Range("H" & x).Value
 
                    TextSql = "insert into ventilation (codeuser, nomuser, jdebutpvt, mdebutpvt, ydebutpvt, temps, qttprelevee, qttruptee, productivite) values ('" & CodeUser & "', '" & NomUser & "', " & jDebutPvt & ", " & mDebutPvt & ", " & yDebutPvt & ", " & Temps & ", '" & QttPrelevee & "', '" & QttRuptee & "', '" & Productivite & "')"
 
                    'On Error GoTo Affiche
                    Dim CmdValeur As New OleDbCommand(TextSql, DBAccess)
                    CmdValeur.ExecuteNonQuery()
 
                    Label1.Text = x
                    x = x + 1
                    appXls.Quit()
                Loop
        End Select
 
    End Sub
 
    Private Sub OpenFileDialog1_FileOk(ByVal sender As System.Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles OpenFileDialog1.FileOk
            Chemin = OpenFileDialog1.FileName
            Importation()
    End Sub
 
    Private Sub FImport_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Label1.Text = "En attente d'intégration ..."
        Interfaces()
    End Sub
 
    Sub Interfaces()
 
        Dim a As Integer = Me.Width
        Dim b As Integer = Label1.Width
        Dim c As Integer = (a - b) / 2
        Label1.Left = c
    End Sub
 
End Class
je ne comprend pas ... alors je sais ma méthode pour lire le fichier excel est pas top mais je viens de VB6 j'ia des vieux reste don't je dois me débarasser