Discussion :

[diamsebony13]

Bonjour,

Je n'ai jamais fait de VBA néanmoins j'ai une demande consistant à mettre à jour un TCD par l'intermédiaire d'une macro grâce à un fichier téléchargé reçu en PJ.
Le besoin existe et fonctionne déjà sur un autre fichier (donc une autre connexion) j'ai récupéré celui ci et mis à jour les infos de connexion. Mon code VBA compile bien :

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
Sub Modifier_Connexion_Utilisateur_Et_Actualisation_TCD ()
 
'**************************************************** NLE le 02/02/2020 *******************************************
'                                                                                                                 *
' Cette macro permet de modifier en fonction de l'utilisateur l'emplacement de la source et d'actualiser le tcd.  *
'                                                                                                                 *
'******************************************************************************************************************
 
If MsgBox("Voulez-vous lancer l'actualisation du tcd ?" & Chr(13) & Chr(10) & "La durée est d'environ une minute.", vbYesNo, "Actualisation") = vbNo Then
 
 MsgBox "Traitement annulé"
 
Else
    Dim stRep As String
    Dim WshShell As Object
    Set WshShell = CreateObject("WScript.Shell")
    stRep = ""
    stRepTemp = ""
    stRepTemp = WshShell.SpecialFolders("Desktop")
    stRep = Replace(stRepTemp, "Desktop", "Downloads")
 
    Dim Répert1 As Object
    Dim Syst_fic As Object
    Dim Fic1 As Object
    Dim Fic_nom As String
    Dim Fic_acces As Date
    Dim Plus_recent_nom As String
    Dim Plus_recent_date As Date
    Dim Répertoire1 As String
    Set Syst_fic = CreateObject("Scripting.FileSystemObject")
 
    'Nom du répertoire à scanner
    Répertoire1 = stRep
    Set Répert1 = Syst_fic.GetFolder(Répertoire1)
 
    'Récupération du fichier le plus récent
    For Each Fic1 In Répert1.Files
        Fic_nom = Fic1.Name
        If Left(Fic_nom, 31) = "Nouvelle Connexion" Then
            Fic_acces = Fic1.datelastaccessed
            If Fic_acces > Plus_recent_date Then
                Plus_recent_date = Fic_acces
                Plus_recent_nom = Fic_nom
            End If
        End If
    Next
    stRep = stRep & "\" & Plus_recent_nom
 
 
    If Right(Plus_recent_nom, 10) = "crdownload" Then
        MsgBox "Un téléchargement est toujours en cours l'actualisation ne peut pas être lancée.", vbCritical
        End
    Else
 
    'Modication de la source du TC avec le chemin stRep le plus récent
    With ActiveWorkbook.Connections("Nouvelle Connexion"). _
            OLEDBConnection
            .BackgroundQuery = False
            .CommandText = Array("'Nouvelle Connexion Extractor - RAW DATA$'")
            .CommandType = xlCmdTable
            .Connection = "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=" & stRep & ";Mode=Share Deny Write;Extended Properties=""HDR=YES;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=37;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=False;Jet OLEDB:Bypass UserInfo Validation=False;Jet OLEDB:Limited DB Caching=False;Jet OLEDB:Bypass ChoiceField Validation=False"
            .RefreshOnFileOpen = False
            .SavePassword = False
            .SourceConnectionFile = ""
            .ServerCredentialsMethod = xlCredentialsMethodIntegrated
            .AlwaysUseConnectionFile = False
        End With
        With ActiveWorkbook.Connections("Nouvelle Connexion")
            .Name = "Nouvelle Connexion"
            .Description = ""
        End With
 
    'Actualisation des TCD
    'ActiveWorkbook.Connections("Nouvelle Connexion").Refresh
    ActiveWorkbook.RefreshAll
 
    'MAJ des infos
    Sheets("Sommaire").Select
    'Range("C17").Select
    Dim Info
    Info = Plus_recent_nom & "      =>  le : " & Date & " à " & Time
    Range("C25").Value = Info
 
 
    MsgBox ("Le TCD est actualisé." & Chr(13) & Chr(10) & "Fin du traitement"), vbInformation
 
    End If
 
End If
 
End Sub

Néanmoins lorsque je souhaite inséré un nouveau tableau croisé dynamique > utiliser connexion externe et que je choisi ma connexion : Nouvelle Connexion. J'ai ceci.





Il semble en fait que ma nouvelle connexion ne soit pas opérationnelle.
Pourriez-vous m'aider ?

Merci