problème de requête externe

[Novice avance !?]

bonjour,

un petit problème se pose à moi

pour faire simple j'ai créé une application access dont la base de donnée source se trouve sur serveur et dont l'applicatif est déployer sur le poste de chaque utilisateur sur son bureau.

d'un formulaire access j'appelle le fichier PERSO_APP.XLS également sur le serveur au même emplacement que ma base de donnée source dans le quel se trouve mes macros de formatage de fichier dont celle-ci :

cette macro appelle une requête dans l'applicatif qui est le sur bureau de chacun des utilisateurs

Sub NumGraph_test()
Const Cible = &H10 'Bureau
Dim objShell As Object
Dim objFolder As Object, objFolderItem As Object
Dim nomdir As String
Dim chem_appli As String
Application.DisplayAlerts = False
 
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(Cible)
    Set objFolderItem = objFolder.Self
 
   nomdir = objFolderItem.Path
   chem_appli = nomdir & "\Application_UO.mdb"
 
   Sheets.Add
   With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
        "ODBC;DSN=MS Access Database;DBQ=chem_appli;DefaultDir=nomdir;DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageT" _
        ), Array("imeout=5;")), Destination:=Range("A1"))
        .CommandText = Array( _
        "SELECT Xls_Num_Thermo_actifs.Code, Xls_Num_Thermo_actifs.Lignes, Xls_Num_Thermo_actifs.`N°Graphique`, Xls_Num_Thermo_actifs.TTypeSteLibellé, Xls_Num_Thermo_actifs.`N°Thermo`" & Chr(13) & "" & Chr(10) & "FROM `F:\DIVERS\Applicati" _
        , "on_UO`.Xls_Num_Thermo_actifs Xls_Num_Thermo_actifs")
        .Name = "Lancer la requête à partir de MS Access Database"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
       [COLOR=blue].Refresh BackgroundQuery:=False[/COLOR]
    End With
'suite du code
Application.DisplayAlerts = true
end sub

le problème est que le chemin de l'emplacement de l'applicatif Application_UO.mdb sur le bureau de chacun est différent pour chaucn.
si pour un c'est

 D:\Documents and Settings\prenom.nom\Bureau

pour un autre ça peut-etre bizaremment

D:\Documents and Settings\prenom.nom.societe\Bureau

...ce qui me pose problème !!!

et ça bloque sur :

.Refresh BackgroundQuery:=False

comment régler ce problème ?

merci par avance

 

[Novice avance !?]

Re : problème de requête externe

je précise qu'en mettant dans le code directement le chemin en remplaçant chem_aplli par D:\Documents and Settings\prenom.nom.societe\Bureau\Application_UO.mdb et nomdir par D:\Documents and Settings\prenom.nom.societe\Bureau par exemple ça marche nickel !

Sheets.Add
With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
"ODBC;DSN=MS Access Database;DBQ=
[COLOR=blue]D:\Documents and Settings\prenom.nom.societe\Bureau\Application_UO.mdb[/COLOR]
;DefaultDir=[COLOR=blue]D:\Documents and Settings\prenom.nom.societe\Bureau[/COLOR];DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageT" _
), Array("imeout=5;")), Destination:=Range("A1"))
.CommandText = Array( _

 

[Novice avance !?]

Re : problème de requête externe

le problème semble venir de :

"SELECT Xls_Num_Thermo_actifs.Code, Xls_Num_Thermo_actifs.Lignes, Xls_Num_Thermo_actifs.`N°Graphique`, Xls_Num_Thermo_actifs.TTypeSteLibellé, Xls_Num_Thermo_actifs.`N°Thermo`" & Chr(13) & "" & Chr(10) & [COLOR=blue]"FROM `F:\DIVERS\Applicati" _
        , "on_UO`.Xls_Num_Thermo_actifs Xls_Num_Thermo_actifs"[/COLOR])

que j'ai oublié de transformer

j'ai donc tester :
en rajoutant:

    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(Cible)
    Set objFolderItem = objFolder.Self
    
   nomdir = objFolderItem.Path
   chem_appli = nomdir & "\Application_UO.mdb"
   [COLOR=blue]chem_appli_bis = nomdir & "\Application_UO"[/COLOR]

   Sheets.Add

With ActiveSheet.QueryTables.Add(Connection:=Array(Array("ODBC;DSN=MS Access Database;DBQ=chem_appli;DefaultDir=nomdir;DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageT"), Array("imeout=5;")), Destination:=Range("A1"))
        .CommandText = Array("SELECT Xls_Num_Thermo_actifs.Code, Xls_Num_Thermo_actifs.Lignes, Xls_Num_Thermo_actifs.`N°Graphique`, Xls_Num_Thermo_actifs.TTypeSteLibellé, Xls_Num_Thermo_actifs.`N°Thermo`" & Chr(13) & "" & Chr(10) & [COLOR=blue]"FROM " & "`" & chem_appli_bis & "`" & ".[/COLOR]Xls_Num_Thermo_actifs Xls_Num_Thermo_actifs")
        .Name = "Lancer la requête à partir de MS Access Database"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        [COLOR=blue].Refresh BackgroundQuery:=False
[/COLOR]    End With

mais ça bloque toujours sur

.Refresh BackgroundQuery:=False

 

[Novice avance !?]

Re : problème de requête externe

ok me suis débrouillé tou seul ! problème résolu !

pour ceux que cela pourrait intéresser s'il se retrouve dans le même cas de figure !

en rouge les modifications apportées

Sub NumGraph()
 
Const Cible = &H10 'Bureau
Dim objShell As Object
Dim objFolder As Object, objFolderItem As Object
[COLOR=red]Dim nomdir As String, chem_appli as String, chem_appli_bis as String[/COLOR]
[COLOR=red] [/COLOR]
Application.DisplayAlerts = False
 
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(Cible)
Set objFolderItem = objFolder.Self
 
nomdir = objFolderItem.Path
chem_appli = nomdir & "\Application_UO.mdb"
[COLOR=red]chem_appli_bis = nomdir  "\Application_UO"[/COLOR]
 
Sheets.Add
With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
"ODBC;DSN=MS Access Database;DBQ[COLOR=red]=" & chem_appli & "[/COLOR][COLOR=black];[/COLOR]DefaultDir[COLOR=red]=" & nomdir & "[/COLOR];DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageT" _
), Array("imeout=5;")), Destination:=Range("A1"))
.CommandText = Array( _
"SELECT Xls_Num_Thermo_actifs.Code, Xls_Num_Thermo_actifs.Lignes, Xls_Num_Thermo_actifs.`N°Graphique`, Xls_Num_Thermo_actifs.TTypeSteLibellé, Xls_Num_Thermo_actifs.`N°Thermo`" & Chr(13) & "" & Chr(10) & [COLOR=red]"FROM `" & chem_appli_bis & " _[/COLOR]
[COLOR=red], "`[/COLOR].Xls_Num_Thermo_actifs Xls_Num_Thermo_actifs")
.Name = "Lancer la requête à partir de MS Access Database"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With
 
'suite du code
 
Application.DisplayAlerts = true
 
end sub

bon week-end

 

[MJ13]

Re : problème de requête externe

Bonjour Novice

Merci pour l'astuce 🙂.