N
Nicolas
Guest
Bonjour à tous,
J'essaie de charger des fichiers excel avec une macro depuis acces
le premier chargement se passe bien
dès que j essaie d'en faire un deuxieme a la suite, ca plante et j ai remarqué qu'il restait un processus excel ouvert
Pourtant je crois avoir bien fermé l'appli dans la macro
Si je charge un fichier apres je ferme access et je recommence ca marche
mais dès que j essaie d'en charger deux à la suite le deuxieme et tous les suivants ne fonctionnent pas
j ai beau cherché mais je ne trouve pas
Merci d'avance des conseils que vous pourrez m apporter
voici le code :
Private Sub Commande0_Click()
On Error GoTo Err_Excel_ALmmande
Dim mysheet As Object
Dim xlApp As Object
Dim plage As Object
Dim dbsFDI As Database
Dim rst As Recordset
Dim strSQL As String
Dim matuser, NomUser, Nomfile, Préfixe, SemaineFile, AnneeFile, FichierComplet As String
Dim Num_FDI, TypeFDI, Activite As String
Dim Charge As Single
Dim longeur, Position, Index, NombredeligneAlire, I As Integer
Dim occurence_AL(7)
Dim tableau_AL()
Dim occurence_PR(4) As Variant
Dim tableau_PR()
Set xlApp = CreateObject("Excel.Application")
' Recherche du fichier à lire
Index = Me.ListBoxFichier.ListIndex
Nomfile = Me.ListBoxFichier.List(Index)
Chemin = Me.Chemin
'Quel type de fichier AL ou PR ?
'AL = Chargement de la table Alocation (ALO = Passé
'PR chargement de la table CAL pour Calendrier = Prévision de présence
Préfixe = Left(Nomfile, 2)
Select Case Préfixe
Case "AL"
'recherche des informations qui compose le nom du fichier
longeur = Len(Nomfile)
Position = InStr(1, Nomfile, ".")
matuser = Mid(Nomfile, 9, Position - 9)
occurence_AL(0) = matuser
AnneeFile = Mid(Nomfile, 6, 2)
occurence_AL(1) = AnneeFile
SemaineFile = Mid(Nomfile, 4, 2)
occurence_AL(2) = SemaineFile
'Vérifier si le salarié existe
Set dbsFDI = CurrentDb()
strSQL = "SELECT EQP_NOM FROM EQP "
strSQL = strSQL & " WHERE EQP_MAT = '" & matuser & "';"
Set rst = dbsFDI.OpenRecordset(strSQL)
If (rst.EOF) Then
'Le salarié n'existe pas faut-il le créer ?
rst.CLOSE
Exit Sub
Else
NomUser = rst!EQP_NOM
rst.CLOSE
End If
FichierComplet = Chemin & "\" & Nomfile
Set mysheet = xlApp.Workbooks.Open(FichierComplet)
'Selection de la première feuille
'mysheet.Sheets("Feuil1").Select
mysheet.Sheets("Feuil1").Range("A1").Select
Set plage = ActiveCell.CurrentRegion
NombredeligneAlire = plage.Rows.Count
'Lecture des lignes
'
For I = 2 To NombredeligneAlire
TypeFDI = Cells(I, 1).Value
occurence_AL(4) = TypeFDI
Num_FDI = Cells(I, 2).Value
occurence_AL(3) = Num_FDI
Activite = Cells(I, 3).Value
occurence_AL(5) = Activite
Charge = Cells(I, 4).Value
occurence_AL(6) = Charge
ReDim Preserve tableau_AL(I - 2)
tableau_AL(I - 2) = occurence_AL
Next
For I = 2 To NombredeligneAlire
'Ecrire l 'enregistrement
strSQL = "INSERT INTO ALO "
strSQL = strSQL & "(ALO_MAT, ALO_YEA, ALO_SEM, ALO_ACT, ALO_NUM, ALO_TYP,ALO_CHG )"
strSQL = strSQL & " VALUES ("
strSQL = strSQL & "'" & tableau_AL(I - 2)(0) & "' ," 'màj matuser
strSQL = strSQL & "'20" & tableau_AL(I - 2)(1) & "' ," 'AnneeFile
strSQL = strSQL & "'" & tableau_AL(I - 2)(2) & "' ," 'SemaineFile
strSQL = strSQL & "'" & tableau_AL(I - 2)(5) & "' ," 'Activite
strSQL = strSQL & "'" & tableau_AL(I - 2)(3) & "' ," 'Num_FDI
strSQL = strSQL & "'" & tableau_AL(I - 2)(4) & "' , " 'TypeFDI
strSQL = strSQL & Chr(34) & tableau_AL(I - 2)(6) & Chr(34) & ") ;" 'Charge
dbsFDI.Execute (strSQL)
Next
MsgBox ("Chargement terminé")
Case "PR"
'recherche des informations qui compose le nom du fichier
longeur = Len(Nomfile)
Position = InStr(1, Nomfile, ".")
matuser = Mid(Nomfile, 4, Position - 4)
occurence_PR(0) = matuser
'Vérifier si le salarié existe
Set dbsFDI = CurrentDb()
strSQL = "SELECT EQP_NOM FROM EQP "
strSQL = strSQL & " WHERE EQP_MAT = '" & matuser & "';"
Set rst = dbsFDI.OpenRecordset(strSQL)
If (rst.EOF) Then
'Le salarié n'existe pas faut-il le créer ?
rst.CLOSE
xlApp.Quit
Exit Sub
Else
NomUser = rst!EQP_NOM
rst.CLOSE
End If
FichierComplet = Chemin & "\" & Nomfile
Set mysheet = xlApp.Workbooks.Open(FichierComplet)
'Selection de la première feuille
mysheet.Sheets("Feuil1").Select
mysheet.Sheets("Feuil1").Range("A1").Select
'mysheet.Sheets("Feuil1").Range("A1").Activate
'ActiveCell.CurrentRegion.Select
plage = mysheet.ActiveCell.CurrentRegion
NombredeligneAlire = plage.Rows.Count
'Lecture des lignes
'
For I = 2 To NombredeligneAlire
Date = Cells(I, 1).Value
occurence_PR(1) = Date
Activite = Cells(I, 2).Value
occurence_PR(2) = Activite
Charge = Cells(I, 3).Value
occurence_PR(3) = Charge
ReDim Preserve tableau_PR(I - 2)
tableau_PR(I - 2) = occurence_PR
Next
For I = 2 To NombredeligneAlire
'Ecrire l 'enregistrement
strSQL = "INSERT INTO CAL "
strSQL = strSQL & "(CAL_MAT, CAL_DT, CAL_TYP_OCC, CAL_CHA )"
strSQL = strSQL & " VALUES ("
strSQL = strSQL & "'" & tableau_PR(I - 2)(0) & "' ," 'màj matuser
strSQL = strSQL & "'" & tableau_PR(I - 2)(1) & "' ," 'Date
strSQL = strSQL & "'" & tableau_PR(I - 2)(2) & "' ," 'Activite
strSQL = strSQL & Chr(34) & tableau_PR(I - 2)(3) & Chr(34) & ") ;" 'Charge
dbsFDI.Execute (strSQL)
Next
MsgBox ("Chargement terminé")
End Select
'Code de fermeture
'mysheet.Application.ActiveWorkbook.Save
mysheet.Application.ActiveWorkbook.CLOSE
'Commande:
xlApp.Quit
Set xlApp = Nothing
Set mysheet = Nothing
Set plage = Nothing
Exit Sub
Err_Excel_ALmmande:
'Code de fermeture
'mysheet.Application.ActiveWorkbook.Save
mysheet.Application.ActiveWorkbook.CLOSE
MsgBox Err.Description
xlApp.Quit
Set xlApp = Nothing
Set mysheet = Nothing
Set plage = Nothing
End Sub
J'essaie de charger des fichiers excel avec une macro depuis acces
le premier chargement se passe bien
dès que j essaie d'en faire un deuxieme a la suite, ca plante et j ai remarqué qu'il restait un processus excel ouvert
Pourtant je crois avoir bien fermé l'appli dans la macro
Si je charge un fichier apres je ferme access et je recommence ca marche
mais dès que j essaie d'en charger deux à la suite le deuxieme et tous les suivants ne fonctionnent pas
j ai beau cherché mais je ne trouve pas
Merci d'avance des conseils que vous pourrez m apporter
voici le code :
Private Sub Commande0_Click()
On Error GoTo Err_Excel_ALmmande
Dim mysheet As Object
Dim xlApp As Object
Dim plage As Object
Dim dbsFDI As Database
Dim rst As Recordset
Dim strSQL As String
Dim matuser, NomUser, Nomfile, Préfixe, SemaineFile, AnneeFile, FichierComplet As String
Dim Num_FDI, TypeFDI, Activite As String
Dim Charge As Single
Dim longeur, Position, Index, NombredeligneAlire, I As Integer
Dim occurence_AL(7)
Dim tableau_AL()
Dim occurence_PR(4) As Variant
Dim tableau_PR()
Set xlApp = CreateObject("Excel.Application")
' Recherche du fichier à lire
Index = Me.ListBoxFichier.ListIndex
Nomfile = Me.ListBoxFichier.List(Index)
Chemin = Me.Chemin
'Quel type de fichier AL ou PR ?
'AL = Chargement de la table Alocation (ALO = Passé
'PR chargement de la table CAL pour Calendrier = Prévision de présence
Préfixe = Left(Nomfile, 2)
Select Case Préfixe
Case "AL"
'recherche des informations qui compose le nom du fichier
longeur = Len(Nomfile)
Position = InStr(1, Nomfile, ".")
matuser = Mid(Nomfile, 9, Position - 9)
occurence_AL(0) = matuser
AnneeFile = Mid(Nomfile, 6, 2)
occurence_AL(1) = AnneeFile
SemaineFile = Mid(Nomfile, 4, 2)
occurence_AL(2) = SemaineFile
'Vérifier si le salarié existe
Set dbsFDI = CurrentDb()
strSQL = "SELECT EQP_NOM FROM EQP "
strSQL = strSQL & " WHERE EQP_MAT = '" & matuser & "';"
Set rst = dbsFDI.OpenRecordset(strSQL)
If (rst.EOF) Then
'Le salarié n'existe pas faut-il le créer ?
rst.CLOSE
Exit Sub
Else
NomUser = rst!EQP_NOM
rst.CLOSE
End If
FichierComplet = Chemin & "\" & Nomfile
Set mysheet = xlApp.Workbooks.Open(FichierComplet)
'Selection de la première feuille
'mysheet.Sheets("Feuil1").Select
mysheet.Sheets("Feuil1").Range("A1").Select
Set plage = ActiveCell.CurrentRegion
NombredeligneAlire = plage.Rows.Count
'Lecture des lignes
'
For I = 2 To NombredeligneAlire
TypeFDI = Cells(I, 1).Value
occurence_AL(4) = TypeFDI
Num_FDI = Cells(I, 2).Value
occurence_AL(3) = Num_FDI
Activite = Cells(I, 3).Value
occurence_AL(5) = Activite
Charge = Cells(I, 4).Value
occurence_AL(6) = Charge
ReDim Preserve tableau_AL(I - 2)
tableau_AL(I - 2) = occurence_AL
Next
For I = 2 To NombredeligneAlire
'Ecrire l 'enregistrement
strSQL = "INSERT INTO ALO "
strSQL = strSQL & "(ALO_MAT, ALO_YEA, ALO_SEM, ALO_ACT, ALO_NUM, ALO_TYP,ALO_CHG )"
strSQL = strSQL & " VALUES ("
strSQL = strSQL & "'" & tableau_AL(I - 2)(0) & "' ," 'màj matuser
strSQL = strSQL & "'20" & tableau_AL(I - 2)(1) & "' ," 'AnneeFile
strSQL = strSQL & "'" & tableau_AL(I - 2)(2) & "' ," 'SemaineFile
strSQL = strSQL & "'" & tableau_AL(I - 2)(5) & "' ," 'Activite
strSQL = strSQL & "'" & tableau_AL(I - 2)(3) & "' ," 'Num_FDI
strSQL = strSQL & "'" & tableau_AL(I - 2)(4) & "' , " 'TypeFDI
strSQL = strSQL & Chr(34) & tableau_AL(I - 2)(6) & Chr(34) & ") ;" 'Charge
dbsFDI.Execute (strSQL)
Next
MsgBox ("Chargement terminé")
Case "PR"
'recherche des informations qui compose le nom du fichier
longeur = Len(Nomfile)
Position = InStr(1, Nomfile, ".")
matuser = Mid(Nomfile, 4, Position - 4)
occurence_PR(0) = matuser
'Vérifier si le salarié existe
Set dbsFDI = CurrentDb()
strSQL = "SELECT EQP_NOM FROM EQP "
strSQL = strSQL & " WHERE EQP_MAT = '" & matuser & "';"
Set rst = dbsFDI.OpenRecordset(strSQL)
If (rst.EOF) Then
'Le salarié n'existe pas faut-il le créer ?
rst.CLOSE
xlApp.Quit
Exit Sub
Else
NomUser = rst!EQP_NOM
rst.CLOSE
End If
FichierComplet = Chemin & "\" & Nomfile
Set mysheet = xlApp.Workbooks.Open(FichierComplet)
'Selection de la première feuille
mysheet.Sheets("Feuil1").Select
mysheet.Sheets("Feuil1").Range("A1").Select
'mysheet.Sheets("Feuil1").Range("A1").Activate
'ActiveCell.CurrentRegion.Select
plage = mysheet.ActiveCell.CurrentRegion
NombredeligneAlire = plage.Rows.Count
'Lecture des lignes
'
For I = 2 To NombredeligneAlire
Date = Cells(I, 1).Value
occurence_PR(1) = Date
Activite = Cells(I, 2).Value
occurence_PR(2) = Activite
Charge = Cells(I, 3).Value
occurence_PR(3) = Charge
ReDim Preserve tableau_PR(I - 2)
tableau_PR(I - 2) = occurence_PR
Next
For I = 2 To NombredeligneAlire
'Ecrire l 'enregistrement
strSQL = "INSERT INTO CAL "
strSQL = strSQL & "(CAL_MAT, CAL_DT, CAL_TYP_OCC, CAL_CHA )"
strSQL = strSQL & " VALUES ("
strSQL = strSQL & "'" & tableau_PR(I - 2)(0) & "' ," 'màj matuser
strSQL = strSQL & "'" & tableau_PR(I - 2)(1) & "' ," 'Date
strSQL = strSQL & "'" & tableau_PR(I - 2)(2) & "' ," 'Activite
strSQL = strSQL & Chr(34) & tableau_PR(I - 2)(3) & Chr(34) & ") ;" 'Charge
dbsFDI.Execute (strSQL)
Next
MsgBox ("Chargement terminé")
End Select
'Code de fermeture
'mysheet.Application.ActiveWorkbook.Save
mysheet.Application.ActiveWorkbook.CLOSE
'Commande:
xlApp.Quit
Set xlApp = Nothing
Set mysheet = Nothing
Set plage = Nothing
Exit Sub
Err_Excel_ALmmande:
'Code de fermeture
'mysheet.Application.ActiveWorkbook.Save
mysheet.Application.ActiveWorkbook.CLOSE
MsgBox Err.Description
xlApp.Quit
Set xlApp = Nothing
Set mysheet = Nothing
Set plage = Nothing
End Sub