Trouver le chemin d'un fichier différent pour chaque utilisateur

Le 03/04/2019 à 12:12

Bonjour

Je vous pose aujourd'hui ce problème et j'espère que l'un d'entre vous aura la solution.

J'ai un fichier Demande de congés utilisé par l'ensemble de mes salarié qui travaillent sous TSE. Ils ne disposent pas tous du même chemin c'est à dire que le nom en dure du serveur, du lecteur ne sont pas les même. Mon fichier fait appelle à un fichier image "signature" enregistré sur un lecteur propre et personnel à chacun appelé P.

Ma macro fonctionne dans un seul cas : le premier (en gras ci-dessous). Peut-on enlever les chemins en dur spécifiés dans la macro et les remplacer par une autre procédure, et laquelle? Ou si celle-ci peut fonctionner merci de me préciser où est mon erreur. Merci par avance de toute l'aide que vous pourrez me porter.

ActiveDocument.Bookmarks("signaturesalarie").Select

Fichier = Dir("\\tsclient\P\signature.jpg")

If Fichier <> "" Then

Set image = Selection.InlineShapes.AddPicture("\\tsclient\P\signature.jpg")

'enregistrement du document pour poste tsclient

ChangeFileOpenDirectory "\\tsclient\R\2.DOCUMENTS GENERAUX\8.FORMULAIRES du PERSONNEL\Congés à valider"

ActiveDocument.SaveAs2 FileName:=ComboBox21 & "" & Format(Date, "yyyy") & "-" & ComboBox22 & ComboBox23 & ComboBox24 & ".doc"

Else: Fichier = Dir("\\client\P\signature.jpg")

If Fichier <> "" Then

Set image = Selection.InlineShapes.AddPicture("\\client\P\signature.jpg") 'enregistrement du document pour poste client

ChangeFileOpenDirectory "\\client\R\2.DOCUMENTS GENERAUX\8.FORMULAIRES du PERSONNEL\Congés à valider"

ActiveDocument.SaveAs2 FileName:=ComboBox21 & "" & Format(Date, "yyyy") & "-" & ComboBox22 & ComboBox23 & ComboBox24 & ".doc"

Else: Fichier = Dir("\\pauline(\\192.168.220.10\users)\P\signature.jpg")

If Fichier <> "" Then

Set image = Selection.InlineShapes.AddPicture("\\pauline(\\192.168.220.10\users)\P\signature.jpg") 'enregistrement du document pour pauline

ChangeFileOpenDirectory "\\pauline(\\192.168.220.10\users)\z\2.DOCUMENTS GENERAUX\8.FORMULAIRES du PERSONNEL\Congés à valider"

ActiveDocument.SaveAs2 FileName:=ComboBox21 & "" & Format(Date, "yyyy") & "-" & ComboBox22 & ComboBox23 & ComboBox24 & ".doc"

Else: Fichier = Dir("\\Netzwerklaufwerk\P\signature.jpg")

Set image = Selection.InlineShapes.AddPicture("\\Netzwerklaufwerk\P\signature.jpg") 'enregistrement du document pour magasin

ChangeFileOpenDirectory "\\Netzwerklaufwerk\R\2.DOCUMENTS GENERAUX\8.FORMULAIRES du PERSONNEL\Congés à valider"

ActiveDocument.SaveAs2 FileName:=ComboBox21 & "" & Format(Date, "yyyy") & "-" & ComboBox22 & ComboBox23 & ComboBox24 & ".doc"

End If

End If

End If

Le 03/04/2019 à 15:03

Bonjour

Voici une proposition. La manip est en 2 temps :

1/ on scanne l'ensemble des lecteurs reliés à l'ordi (Function List_Lecteurs). La liste générée comprend pour chaque lecteur le type et la lettre-index. Un lecteur réseau est de type 3.

2/ pour chaque lecteur de type 3, on scanne alors l'ensemble des dossiers et des sous-dossiers jusqu'à trouver le sous-dossier "P" (Sub Trouve_Rep). Un fois trouvé, on récupère le chemin complet du "signature.jpg"

NB : ça peut être long car on scanne l'ensemble des dossiers et des sous-dossiers (et sur un lecteur-réseau, ça peut être très-très-très long!). En revanche si le sous-dossier "P" est toujours à la même "profondeur" on pourrait raccourcir le processus.

Public Chemin As String

Sub Go()
Dim T() As String, i As Integer

    Chemin = ""
    T = List_Lecteurs
    For i = 0 To UBound(T, 2) - 1
        If T(0, i) = 3 Then Trouve_Rep T(1, i), "P"
    Next i

    MsgBox Chemin & "\signature.jpg"
End Sub

Function List_Lecteurs() As Variant
Dim Fso As Object, Drv As Object, T() As String, idx As Integer

    idx = 0
    ReDim T(1, idx)
    Set Fso = CreateObject("Scripting.FileSystemObject")
    For Each Drv In Fso.Drives
        If Drv.IsReady Then
            T(0, UBound(T, 2)) = Drv.DriveType
            T(1, UBound(T, 2)) = Drv.DriveLetter & ":\"
            idx = idx + 1
            ReDim Preserve T(1, idx)
        End If
    Next Drv
    List_Lecteurs = T
    Set Fso = Nothing
End Function

Sub Trouve_Rep(Racine As String, Rep As String)
Dim Fso As Object, SourceFolder As Object, SubFolder As Object, Item As Object

    If Not Chemin = "" Then Exit Sub
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Racine)

    For Each Item In SourceFolder.Subfolders
        If Item.Name = Rep Then
            Chemin = Item.ParentFolder & "\" & Item.Name
            Exit Sub
        End If
    Next Item

    For Each SubFolder In SourceFolder.Subfolders
        On Error Resume Next
        Trouve_Rep SubFolder.Path, Rep
        On Error GoTo 0
    Next SubFolder
    Set Fso = Nothing
End Sub

Pierre

Le 03/04/2019 à 17:10

Merci pour cette réponse. Je teste demain. Par contre effectivement le dossier P est toujours à la même profondeur pour tout le monde et donc si vous avez une réponse plus rapide je prend.

Le 03/04/2019 à 18:01

Ah bien,

Alors si le dossier P est à un "niveau 2" du genre : G:\Dossier_niv1\P\signature.jpg

On gagne énormément de temps avec ce code :

Public Chemin As String

Sub Go()
Dim T() As String, i As Integer

    Chemin = ""
    T = List_Lecteurs
    For i = 0 To UBound(T, 2) - 1
        'If T(0, i) = 3 Then Trouve_Rep T(1, i), "P"
        Trouve_Rep_Court T(1, i), "P"  ' ou même : If T(0, i) = 3 Then Trouve_Rep_Court T(1, i), "P"
    Next i
    MsgBox Chemin & "\signature.jpg"
End Sub

Function List_Lecteurs() As Variant
Dim Fso As Object, Drv As Object, T() As String, idx As Integer

    idx = 0
    ReDim T(1, idx)
    Set Fso = CreateObject("Scripting.FileSystemObject")
    For Each Drv In Fso.Drives
        If Drv.IsReady Then
            T(0, UBound(T, 2)) = Drv.DriveType
            T(1, UBound(T, 2)) = Drv.DriveLetter & ":\"
            idx = idx + 1
            ReDim Preserve T(1, idx)
        End If
    Next Drv
    List_Lecteurs = T
    Set Fso = Nothing
End Function

Sub Trouve_Rep_Court(Racine As String, Rep As String)
Dim Fso As Object, SourceFolder As Object, SubFolder As Object, Item As Object

    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Racine)
    For Each Item In SourceFolder.Subfolders
        If Exist_Rep(Item.ParentFolder & Item.Name & "\" & Rep) Then
            Chemin = Item.ParentFolder & Item.Name & "\" & Rep
            Exit Sub
        End If
    Next Item
    Set Fso = Nothing
End Sub

Function Exist_Rep(NTtk As String) As Boolean
    On Error Resume Next
    Exist_Rep = GetAttr(NTtk) And vbDirectory
End Function
Le 04/04/2019 à 08:27

Bonjour

J'essai votre première solution mais j'ai une erreur "erreur de compilation : Sub ou fonction mal définie".

VB me souligne "then trouve_rep" dans la syntaxe suivante.

Dim T() As String, i As Integer

Chemin = ""

T = List_Lecteurs

For i = 0 To UBound(T, 2) - 1

If T(0, i) = 3 Then Trouve_Rep T(1, i), "P"

Next i

MsgBox Chemin & "\signature.jpg"

Merci pour votre réponse

Le 04/04/2019 à 08:34

J'ai une précision à apporter "P" n'est pas un sous-dossier, je crois, mais un lecteur .

Je vous explique notre Installation

nous avons un serveur de données situé en Allemagne et un en France. Mes fichiers sont situés sur notre serveur en France auquel on accède par l'Allemagne.

Nous allons en Allemagne via CITRIX pour accéder à nos données ici en France, l'intérêt est que nous travaillons tous à distance de nos données. Tout le monde ne peut pas accéder directement à ce serveur français. Le lecteur P existe pour chacun de nous sur le serveur en France. C'est le nom donné à ce serveur qui est différent d'un invidu à l'autre.

Le 04/04/2019 à 11:27

Bonjour,

En effet ce n'est donc pas un lecteur intranet.

On peut néanmoins faire un test.

Avec ce fichier joint on peut lister les différents lecteurs auxquels on peut accéder par cette méthode. On verra si l'extranet est accessible avec de code.

Ce serait bien de poster le résultat de ce test.

Merci

8test-lecteurs.xlsm (22.13 Ko)
Le 04/04/2019 à 11:49

J'ai fait une recherche entre temps et j'ai trouvé cela, qui je pense me simplifierai le processus?

' Insertion Signature Salarié

Dim image As Object

Dim Fichier As String

Dim Path_name As String

Dim Signature As String

Dim Complete_File_name As String

Path_name = ThisDocument.Path 'récupère le chemin complet de la macro

'Je récupère ainsi la racine de mon fichier

ActiveDocument.Bookmarks("signaturesalarie").Select

Fichier = Path_name & "\" & Signature & ".jpg"

'Set image = Selection.InlineShapes.AddPicture("\\tsclient\P\signature.jpg") ' avant j'avait cette formulation

Set image = Selection.InlineShapes.AddPicture(fichier) 'aujourd'hui il me faudrait celle-ci mais elle ne fonctionne pas

Cela me met erreur fichier invalide

Avez-vous une idée merci

Le 04/04/2019 à 17:08

Voilà parce que servir à tout le monde

' Déclaration des variables - Récupération du chemin de la macro

Dim image As Object '

Dim Fichier As String '

Dim Chemin As String ' Chemin de la macro

Dim Signature As String ' Nom du fichier signature personnelle

Dim NomServeurP As String 'lecteur personnel

Dim NomServeurR As String 'lecteur commun - attention Z pour Pauline

Dim CheminServeurR As String 'chemin lecteur general

Dim Fichierimage As String ' Chemin du fichier image signature

Dim FichierCongés As String

Chemin = ThisDocument.Path 'récupère le chemin complet de la macro

'Récupèrer le nom du lecteur personnel

NomServeurP = Left(Chemin, Len(Chemin) - 50) 'pour macro sous lecteur général

'Fichier = Dir(NomServeurP & "\" & "P" & "\" & "Signature" & ".jpg")

Fichierimage = NomServeurP & "\" & "P" & "\" & "Signature" & ".jpg" 'récupération du chemin du fichier image signature

MsgBox Fichierimage

'NomServeurP = Left(Chemin, Len(Chemin) - 8) 'pour macro sous P

'Fichier = Dir(NomServeurP & "\" & "P" & "\" & "Signature" & ".jpg")

'Fichierimage = NomServeurP & "\" & "P" & "\" & "Signature" & ".jpg"

'MsgBox Fichierimage

'Insertion Signature du demandeur

Selection.GoTo What:=wdGoToBookmark, Name:="signaturesalarie"

With ActiveDocument.Bookmarks

.DefaultSorting = wdSortByName

.ShowHidden = True

End With

Selection.InlineShapes.AddPicture FileName:=Fichierimage, LinkToFile _

:=False, SaveWithDocument:=True

'Récupèrer le nom du lecteur commun et enregistre le document dans le Dossier Congés à valider

'NomServeurR = Left(Chemin, Len(Chemin) - 8) 'pour macro sous P

'CheminServeurR = NomServeurR & "\" & "r" & "\" & "2.DOCUMENTS GENERAUX\8.FORMULAIRES du PERSONNEL\Congés à valider"""

NomServeurR = Left(Chemin, Len(Chemin) - 47) 'pour macro sous dossier modèle

FichierCongés = Dir(NomServeurR & "2.DOCUMENTS GENERAUX\8.FORMULAIRES du PERSONNEL\Congés à valider")

CheminServeurR = NomServeurR & "2.DOCUMENTS GENERAUX\8.FORMULAIRES du PERSONNEL\Congés à valider" 'récupération du chemin du dossier ou enregistrér le document

MsgBox CheminServeurR

ChangeFileOpenDirectory (CheminServeurR)

ActiveDocument.SaveAs2 FileName:=ComboBox21 & "" & Format(Date, "yyyy") & "-" & ComboBox22 & ComboBox23 & ComboBox24 & ".doc"

Rechercher des sujets similaires à "trouver chemin fichier different chaque utilisateur"