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
| Public Function importTest()
Dim varData As Variant
Dim rst As Recordset
Dim intLoop As Integer
Dim intCount As Integer
Dim base As String
Dim crit As String
Dim Sqltext As String
Dim jauge As Variant
DoCmd.SetWarnings False
'vide la table des tiers
DoCmd.RunSQL ("DELETE F_EcritureC.* FROM F_EcritureC;")
' Ouvrir la table des sociétes
Set rst = CurrentDb.OpenRecordset("SELECT Societes.[Dossier compta],Societes.[Critctnum] FROM Societes WHERE (((Societes.[Dossier compta]) Is Not Null)) AND ((Societes.[Société]='NomdeEntreprise')) ORDER BY Societes.[Dossier compta];", dbOpenDynaset)
rst.MoveLast
'Compter le nombre de societes
intCount = rst.RecordCount
ReDim aFullArray(1 To intCount)
rst.MoveFirst
varData = rst.GetRows(intCount)
rst.Close
jauge = SysCmd(acSysCmdInitMeter, "Importation des bases", UBound(aFullArray))
'Pour chacune des sociétes
For intLoop = LBound(aFullArray) To UBound(aFullArray)
base = varData(0, intLoop - 1)
'crit = varData(1, intLoop - 1)
'supprime la table temporaire (Nom de dossier de la societe) si elle existe
If fExistTable(base) Then
DoCmd.DeleteObject acTable, base
End If
jauge = SysCmd(acSysCmdSetStatus, "Importation Tiers " & base)
'Importe la table en totalité (voir comment faire sauter la demande du mot de passe)
Sqltext = "ODBC;DSN=sage;APP=Microsoft Office XP;WSID=P101;PWD=cyborg;DATABASE=" & base & ";Network=DBMSSOCN;TABLE=dbo.F_ECRITUREC"
'acImport = TypeTransfert, ODBC = NomBase, Sqltext = TypeObjet, Nom de la table, Source, Destination,Structure
DoCmd.TransferDatabase acImport, "ODBC", Sqltext, acTable, "F_ECRITUREC", base, , True
Debug.Print Sqltext
jauge = SysCmd(acSysCmdSetStatus, "Mise à jour table locale")
Ste = base
' Ajoute dans la table des grands livres sur la période définie
Sqltext = "INSERT INTO F_EcritureC (JO_Num, EC_No, EC_NoLink, JM_Date, EC_Jour, EC_Date, EC_Piece, CG_Num, CG_NumCont, CT_Num, EC_Intitule, EC_Echeance, N_Devise, EC_Sens,EC_Montant, EC_Lettre, EC_Lettrage, CT_NumCont, EC_Devise, cb_Marq)"
Sqltext = Sqltext + "SELECT '" & Ste & "' .JO_Num, " & Ste & ".EC_No, " & Ste & ".EC_NoLink, " & Ste & ".JM_Date, " & Ste & ".EC_Date, " & Ste & ".EC_Piece, " & Ste & ".CG_Num, " & Ste & ".CG_NumCont, " & Ste & ".CT_Num, " & Ste & ".EC_Intitule, " & Ste & ".EC_Echeance, " & Ste & ".N_Devise, " & Ste & ".EC_Sens, " & Ste & ".EC_Montant," & Ste & ".EC_Lettre," & Ste & ".EC_Lettrage," & Ste & ".CT_NumCont," & Ste & ".EC_Devise," & Ste & ".cb_Marq"
Sqltext = Sqltext + " FROM " & Ste & " WHERE EC_Lettre=0 AND JM_Date > '31/12/2007' AND CG_Num ='411000' OR CG_Num='413000' ;"
DoCmd.RunSQL Sqltext
Debug.Print Sqltext
jauge = SysCmd(acSysCmdSetStatus, "Suppression table d'import ")
'Détruit la table d'import
DoCmd.DeleteObject acTable, base
DoCmd.RunSQL ("UPDATE F_EcritureC SET F_EcritureC.JO_Num = F_EcritureC.EC_No WHERE F_EcritureC.JO_Num='';")
Next intLoop
jauge = SysCmd(acSysCmdSetStatus, "Import terminé")
DoCmd.SetWarnings True
End Function |
Erreur 3346 Qui me dit
Répondre avec citation
Envoyé par zilfana63
Partager