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
| '------------------------------------
'---- Procédures sur les boutons ----
'------------------------------------
'---- Bouton "..." : choix de la table à ajouter ----
'---- Récupération du repertoire sélectionné ----
Private Sub btn_parcourir_Click()
Dim Chemin As String
opg_contenu.Enabled = False
Me.opg_contenu.Value = Null
btn_import.Enabled = False
Chemin = OuvrirUnFichier(Me.Hwnd, "Sélectionner le fichier à mettre à jour...", 2)
If Chemin <> "" Then
Me.txt_table = Chemin
opg_contenu.Enabled = True
End If
End Sub
Private Sub opg_contenu_Click()
Me.btn_import.Enabled = True
End Sub
Private Sub btn_import_Click()
Dim w_sql As String
Dim w_fichier As String
'On Error GoTo trait_erreur_import
w_fichier = Me.txt_table.Value
w_fichier = Left(w_fichier, InStr(1, w_fichier, ".") - 1)
w_sql = ""
If Not IsNull(Me.opg_contenu.Value) Then
Select Case Me.opg_contenu.Value
Case 0 'Fichier consulaire
'---- Ajout des nouveaux enregistrements ----
w_sql = "INSERT INTO etablissement(eta_siret, eta_coord_l93_X, eta_coord_l93_Y, eta_coord_wgs84_E, eta_coord_wgs84_N, eta_raison_soc, eta_enseigne, eta_sigle, eta_nom_com, eta_nom_reel, eta_ad_num, eta_ad_num2, eta_indice_repet, eta_adresse_lib, eta_ad_complement, eta_cp, eta_cc, eta_telephone, eta_fax, eta_site_web, eta_capsoc_etp, eta_date_creation, eta_effectif, eta_eff_date, eta_com_act, eta_origine, eta_etp_siren, eta_apet_code, eta_statut, eta_siege_social, eta_acm) "
w_sql = w_sql & "SELECT " & w_fichier & ".siret_entreprise, " & w_fichier & ".Coord_X_L93, " & w_fichier & ".Coord_Y_L93, " & w_fichier & ".Coord_E_WGS84, " & w_fichier & ".Coord_N_WGS84, " & w_fichier & ".raison_soc, " & w_fichier & ".enseigne, " & w_fichier & ".sigle, " & w_fichier & ".nom_com, " & w_fichier & ".nom_reel, " & w_fichier & ".num_voie, " & w_fichier & ".num_voie2, " & w_fichier & ".indice_repet, " & w_fichier & ".adresse_lib, " & w_fichier & ".ad_complement, " & w_fichier & ".code_postal, " & w_fichier & ".code_commune, " & w_fichier & ".telephone, " & w_fichier & ".fax, " & w_fichier & ".site_web, " & w_fichier & ".capital, " & w_fichier & ".date_creation, " & w_fichier & ".effectif, " & w_fichier & ".date_effectif, " & w_fichier & ".com_act, " & w_fichier & ".origine, Left(" & w_fichier & ".siret_entreprise,9), " & w_fichier & ".ape_entreprise"
w_sql = w_sql & ", " & w_fichier & ".statut, " & w_fichier & ".siege_social, " & w_fichier & ".accord_mail "
w_sql = w_sql & "FROM " & w_fichier & " LEFT JOIN etablissement ON " & w_fichier & ".[siret_entreprise] = etablissement.[eta_siret] "
w_sql = w_sql & "WHERE (((etablissement.eta_siret) Is Null));"
DoCmd.SetWarnings False
DoCmd.RunSQL w_sql
DoCmd.SetWarnings True
'---- Sur le champ eta_adresse_lib, résultant de la concaténation des champs contenant la désignation (rue, place...) et le nom de la voie), si il n'y a pas de désignation, un espace sera présent. Ainsi, on enleve cet espace (premier caractère est un espace alors on le supprimme)
w_sql = ""
w_sql = "UPDATE etablissement, " & w_fichier & " "
w_sql = w_sql & "SET etablissement.eta_adresse_lib = " & w_fichier & ".nom_voie "
w_sql = w_sql & "WHERE (Left(eta_adresse_lib, 1)=' ') AND (etablissement.eta_siret = " & w_fichier & ".siret_entreprise));"
DoCmd.SetWarnings False
DoCmd.RunSQL w_sql
DoCmd.SetWarnings True
'---- Champ eta_etp_siren : ajout de la forme juridique si le siren n'est pas existant ===> a tester ----
w_sql = ""
w_sql = "UPDATE entreprise, " & w_fichier & " "
w_sql = "SET entreprise.etp_siren = Left(" & w_fichier & ".siret_entreprise,9), entreprise.fj_code = " & w_fichier & ".forme_juridique"
w_sql = "WHERE (etablissement.eta_siret = " & w_fichier & ".siret_entreprise) AND ((eta_tp_siren) Is Null);"
DoCmd.SetWarnings False
DoCmd.RunSQL w_sql
DoCmd.SetWarnings True
'---- Mise à jour des champs de traçabilité géographique ----
'---- Ajout des eta_id et des sirets absents dans la table modification ----
w_sql = ""
w_sql = "INSERT INTO modification(mdf_eta_id, mdf_siret) "
w_sql = w_sql & "SELECT etablissement.eta_id, etablissement.eta_siret "
w_sql = w_sql & "FROM etablissement LEFT JOIN modification ON etablissement.[eta_id] = modification.[mdf_eta_id] "
w_sql = w_sql & "WHERE (((modification.mdf_eta_id) Is Null));"
DoCmd.SetWarnings False
DoCmd.RunSQL w_sql
DoCmd.SetWarnings True
'---- Mise des champs echelle, type et organisme ----
w_sql = ""
w_sql = "UPDATE modification, " & w_fichier & " "
w_sql = w_sql & "SET modification.mdf_echelle = " & w_fichier & ".ECH_GEO, modification.mdf_type = " & w_fichier & ".TYP_GEO, modification.mdf_organisme = " & w_fichier & ".ORG_GEO, modification.mdf_date = " & w_fichier & ".DAT_GEO "
w_sql = w_sql & "WHERE ((modification.mdf_siret = " & w_fichier & ".siret_entreprise) AND ((modification.mdf_organisme) Is Null);"
DoCmd.SetWarnings False
DoCmd.RunSQL w_sql
DoCmd.SetWarnings True
'---- Mise à jour des établissements actifs déjà présents ----
w_sql = ""
w_sql = "UPDATE etablissement, " & w_fichier & " "
w_set = "SET etablissement.eta_telephone = " & w_fichier & ".telephone, etablissement.eta_fax =" & w_fichier & ".fax, etablissement.eta_site_web = " & w_fichier & ".site_web, etablissement.eta_acm = " & w_fichier & ".accord_mail, etablissement.eta_effectif = " & w_fichier & ".effectif, etablissement.eta_eff_date = " & w_fichier & ".date_effectif, etablissement.eta_origine = " & w_fichier & ".origine "
w_where = "WHERE (((etablissement.eta_origine_id) Like '*CCI*' ) AND (etablissement.eta_siret = " & w_fichier & ".siret_entreprise));"
w_sql = w_sql & w_set & w_where
DoCmd.SetWarnings False
DoCmd.RunSQL w_sql
DoCmd.SetWarnings True
MsgBox "La mise à jour via le fichier consulaire a été effectuée avec succès!", vbInformation, "Import terminé" End Select
Else
MsgBox "Veuillez d'abord choisir un type de contenu!", vbExclamation, Erreur!
End If
'fin:
' Exit Sub
'trait_erreur_import:
' MsgBox "Erreur lors de l'import! L'opération a été stoppée.", vbExclamation, "Erreur..."
' Resume fin
End Sub |
Partager