Bonjour à toutes et tous,
J'ai un petit fichier qui a marché pendant des années et qui depuis plusieurs mois ne fonctionne plus sans raisons.
Avant de commencer, le but de ce fichier est d'extraire des données dans une base de données IBM AS400 puis de les mettes en forme.
Uneame charitable serait-elle me dire si quelque chose cloche au niveau de l'extraction?
nom du classeur : nmmencaltures
Bibliothéque attaqué via un ODBC : "V61BPFR" et "MOIS"
DSN : BPCS
BPROD,BCHLD,IIML01.IDESC,BQREQ ... correspond aux noms des données a rappatrier
Qd je rappatrie mon EXCEL plante ou tourne des "heures" pour ne rien extraire
Cordialement
--------------------------------------------------------------
Public classeur As Workspace
Public Base_v61 As Database
Public Base_MOIS As Database
Public LesEnregist1 As Recordset, LesEnregist2 As Recordset, LesEnregist3 As Recordset, LesEnregist4 As Recordset
Public ident As String, mot_de_passe As String
Public Connect As Boolean, Connect1 As Boolean
Public art As String, art1 As String
Public w As Integer
Public tot_op As Double, tot_piece As Double
Sub extraction()
Sheets("nomenclatures").Select
art = Sheets("nomenclatures").TextBox4.Value
tot_op = 0
tot_piece = 0
'If Connect = False Then
Set classeur = CreateWorkspace("", "admin", "", dbUseJet)
Set Base_v61 = classeur.OpenDatabase("BPCS", _
dbDriverNoPrompt, True, _
"ODBC;DATABASE=v61bpfr;UID=" & ident & " ;PWD= " & mot_de_passe & ";DSN=BPCS")
' Connect = True
'End If
'If Connect1 = False Then
Set classeur1 = CreateWorkspace("", "admin", "", dbUseJet)
Set Base_MOIS = classeur1.OpenDatabase("BPCS1", _
dbDriverNoPrompt, True, _
"ODBC;DATABASE=MOIS;UID=" & ident & " ;PWD= " & mot_de_passe & ";DSN=BPCS1")
' Connect1 = True
'End If
Range(Cells(8, 1), Cells(1000, 10)).ClearContents
Set LesEnregist2 = Base_v61.OpenRecordset("SELECT BPROD,BCHLD,IIML01.IDESC,BQREQ FROM MBML01 LEFT OUTER JOIN IIML01 ON (MBML01.BCHLD=IIML01.IPROD) WHERE (BPROD='" & art & "') ;")
If LesEnregist2.BOF = False Then
With LesEnregist2
.MoveLast
.MoveFirst
Nb2 = (.RecordCount)
End With
For p = 1 To Nb2
For i = 0 To 3
Cells(p + 7, i + 1) = LesEnregist2.Fields(i)
Next i
LesEnregist2.MoveNext
Next p
LesEnregist2.Close
End If
z = 8
While (Cells(z, 2) <> "")
art1 = "" & Cells(z, 2) & ""
Set LesEnregist3 = Base_v61.OpenRecordset("SELECT CFTLVL+CFPLVL FROM CMF WHERE (CFFAC='LI' AND CFCSET=2 AND CFCBKT=0 AND CFPROD='" & art1 & "') ;")
If LesEnregist3.BOF = False Then
With LesEnregist3
.MoveLast
.MoveFirst
Nb3 = (.RecordCount)
End With
Cells(z, 5) = LesEnregist3.Fields(0)
Cells(z, 6).FormulaR1C1 = "=RC[-1]*RC[-2]"
tot_piece = tot_piece + Cells(z, 6)
LesEnregist3.MoveNext
LesEnregist3.Close
End If
z = z + 1
Wend
Sheets("opérations").Select
Range(Cells(10, 1), Cells(1000, 10)).ClearContents
Set LesEnregist4 = Base_v61.OpenRecordset("SELECT IDESC FROM IIML01 WHERE (IPROD='" & art & "') ;")
If LesEnregist4.BOF = False Then
With LesEnregist4
.MoveLast
.MoveFirst
Nb4 = (.RecordCount)
End With
Sheets("nomenclatures").TextBox5.Value = LesEnregist4.Fields(0)
LesEnregist4.MoveNext
LesEnregist4.Close
End If
Set LesEnregist1 = Base_v61.OpenRecordset("SELECT RPROD,RWRKC,ROPDS,RLAB,LWK.WLRTE,RLAB*LWK.WLRTE FROM FRT LEFT OUTER JOIN LWK ON (FRT.RWRKC=LWK.WWRKC) WHERE (RPROD='" & art & "') ;")
If LesEnregist1.BOF = False Then
With LesEnregist1
.MoveLast
.MoveFirst
Nb1 = (.RecordCount)
End With
For p = 1 To Nb1
For i = 0 To 5
Cells(p + 9, i + 1) = LesEnregist1.Fields(i)
Next i
tot_op = tot_op + Cells(p + 9, 6)
LesEnregist1.MoveNext
Next p
LesEnregist1.Close
End If
Sheets("nomenclatures").Select
Sheets("nomenclatures").TextBox1.Value = tot_piece
Sheets("nomenclatures").TextBox2.Value = tot_op
Sheets("nomenclatures").TextBox3.Value = tot_op + tot_piece
Debug.Print "" & tot_op & " " & tot_piece & ""
End Sub
J'ai un petit fichier qui a marché pendant des années et qui depuis plusieurs mois ne fonctionne plus sans raisons.
Avant de commencer, le but de ce fichier est d'extraire des données dans une base de données IBM AS400 puis de les mettes en forme.
Uneame charitable serait-elle me dire si quelque chose cloche au niveau de l'extraction?
nom du classeur : nmmencaltures
Bibliothéque attaqué via un ODBC : "V61BPFR" et "MOIS"
DSN : BPCS
BPROD,BCHLD,IIML01.IDESC,BQREQ ... correspond aux noms des données a rappatrier
Qd je rappatrie mon EXCEL plante ou tourne des "heures" pour ne rien extraire
Cordialement
--------------------------------------------------------------
Public classeur As Workspace
Public Base_v61 As Database
Public Base_MOIS As Database
Public LesEnregist1 As Recordset, LesEnregist2 As Recordset, LesEnregist3 As Recordset, LesEnregist4 As Recordset
Public ident As String, mot_de_passe As String
Public Connect As Boolean, Connect1 As Boolean
Public art As String, art1 As String
Public w As Integer
Public tot_op As Double, tot_piece As Double
Sub extraction()
Sheets("nomenclatures").Select
art = Sheets("nomenclatures").TextBox4.Value
tot_op = 0
tot_piece = 0
'If Connect = False Then
Set classeur = CreateWorkspace("", "admin", "", dbUseJet)
Set Base_v61 = classeur.OpenDatabase("BPCS", _
dbDriverNoPrompt, True, _
"ODBC;DATABASE=v61bpfr;UID=" & ident & " ;PWD= " & mot_de_passe & ";DSN=BPCS")
' Connect = True
'End If
'If Connect1 = False Then
Set classeur1 = CreateWorkspace("", "admin", "", dbUseJet)
Set Base_MOIS = classeur1.OpenDatabase("BPCS1", _
dbDriverNoPrompt, True, _
"ODBC;DATABASE=MOIS;UID=" & ident & " ;PWD= " & mot_de_passe & ";DSN=BPCS1")
' Connect1 = True
'End If
Range(Cells(8, 1), Cells(1000, 10)).ClearContents
Set LesEnregist2 = Base_v61.OpenRecordset("SELECT BPROD,BCHLD,IIML01.IDESC,BQREQ FROM MBML01 LEFT OUTER JOIN IIML01 ON (MBML01.BCHLD=IIML01.IPROD) WHERE (BPROD='" & art & "') ;")
If LesEnregist2.BOF = False Then
With LesEnregist2
.MoveLast
.MoveFirst
Nb2 = (.RecordCount)
End With
For p = 1 To Nb2
For i = 0 To 3
Cells(p + 7, i + 1) = LesEnregist2.Fields(i)
Next i
LesEnregist2.MoveNext
Next p
LesEnregist2.Close
End If
z = 8
While (Cells(z, 2) <> "")
art1 = "" & Cells(z, 2) & ""
Set LesEnregist3 = Base_v61.OpenRecordset("SELECT CFTLVL+CFPLVL FROM CMF WHERE (CFFAC='LI' AND CFCSET=2 AND CFCBKT=0 AND CFPROD='" & art1 & "') ;")
If LesEnregist3.BOF = False Then
With LesEnregist3
.MoveLast
.MoveFirst
Nb3 = (.RecordCount)
End With
Cells(z, 5) = LesEnregist3.Fields(0)
Cells(z, 6).FormulaR1C1 = "=RC[-1]*RC[-2]"
tot_piece = tot_piece + Cells(z, 6)
LesEnregist3.MoveNext
LesEnregist3.Close
End If
z = z + 1
Wend
Sheets("opérations").Select
Range(Cells(10, 1), Cells(1000, 10)).ClearContents
Set LesEnregist4 = Base_v61.OpenRecordset("SELECT IDESC FROM IIML01 WHERE (IPROD='" & art & "') ;")
If LesEnregist4.BOF = False Then
With LesEnregist4
.MoveLast
.MoveFirst
Nb4 = (.RecordCount)
End With
Sheets("nomenclatures").TextBox5.Value = LesEnregist4.Fields(0)
LesEnregist4.MoveNext
LesEnregist4.Close
End If
Set LesEnregist1 = Base_v61.OpenRecordset("SELECT RPROD,RWRKC,ROPDS,RLAB,LWK.WLRTE,RLAB*LWK.WLRTE FROM FRT LEFT OUTER JOIN LWK ON (FRT.RWRKC=LWK.WWRKC) WHERE (RPROD='" & art & "') ;")
If LesEnregist1.BOF = False Then
With LesEnregist1
.MoveLast
.MoveFirst
Nb1 = (.RecordCount)
End With
For p = 1 To Nb1
For i = 0 To 5
Cells(p + 9, i + 1) = LesEnregist1.Fields(i)
Next i
tot_op = tot_op + Cells(p + 9, 6)
LesEnregist1.MoveNext
Next p
LesEnregist1.Close
End If
Sheets("nomenclatures").Select
Sheets("nomenclatures").TextBox1.Value = tot_piece
Sheets("nomenclatures").TextBox2.Value = tot_op
Sheets("nomenclatures").TextBox3.Value = tot_op + tot_piece
Debug.Print "" & tot_op & " " & tot_piece & ""
End Sub