Générer un lien http à partir d'un fichier réseau

Version imprimable

25/09/2015, 11h54
keenawy

Générer un lien http à partir d'un fichier réseau

Bonjour à tous,

Je recherche script qui permette de générer un lien http dans le presse-papier à partir d'un lien Windows.

Exemple:
Pour un fichier stocké dans \\serveur\partage\fichier.xls, je voudrais générer le le lien "http://extranet.fr/fichier.xls" dans le presse-papier.

Le but est de faciliter la publication du lien http dans un mail sans avoir besoin de taper "http://extranet.fr/fichier.xls". Je pensais à sélectionner un fichier dans une boite de dialogue puis le script générerait le lien avec "http://extranet.fr/nom_du_fichier " dans le presse-papier. Il n'y aurait plus qu'à coller le lien dans un mail.

Quelqu'un aurait une idée ? Une manière plus simple ? Merci

Générer plusieurs liens http à partir de plusieurs fichiers réseaux

En récupérant des bouts de code, j'arrive à générer un lien à la fois

Code:

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
Sub test()
  Dim Fichier As FileDialog
  Dim strFilePath As String
  Dim str As String, rep As String
  Dim Lien
  Dim MyData As New DataObject
  Dim Message
 
    'Sélection du fichier
    Set Fichier = Application.FileDialog(msoFileDialogOpen)
    With Fichier
        .Title = "Sélectionnez le fichier pour générer le lien Internet"
        .InitialFileName = "\\serveur\Partage\"
        .Show
    End With
 
    'Extraction du nom de fichier
    str = Fichier.SelectedItems(1)
    rep = Mid(str, InStrRev(str, "\") + 1)
    Debug.Print rep
 
    'Formatage du lien http
    Lien = "http://extranet.fr/Partage/" & rep
 
    'Copie du lien dans le presse-papier
    MyData.SetText Lien
    MyData.PutInClipboard
 
    'Message copie réussie
    Message = "Le lien du fichier suivant a bien été copié : " & rep
    MsgBox Message, vbInformation, "Lien copié avec succès"
 
End Sub

Cependant, ça ne marche que pour un lien à la fois. Je voudrais pouvoir sélectionner plusieurs fichiers et générer plusieurs liens en une seule fois.

Des propositions ? Merci :)

Modifie le bloc With ....End With de la façon suivante :

Code:

1
2
3
4
5
6
    With Fichier
        .Title = "Sélectionnez le fichier pour générer le lien Internet"
        .InitialFileName = "\\serveur\Partage\"
        .AllowMultiSelect = True  ' => Sélection multiple
        .Show
    End With

puis traite la sortie dans une boucle.

25/09/2015, 16h44
keenawy

Merci pour ton retour l_autodidacte

J'arrive bien à récupérer le lien modifié de chaque fichier mais le contenu du presse-papier est écrasé à chaque fois ^^

Je sais pas trop comment faire ...
Essayer d'ajouter les liens dans le presse-papier sans l'écraser à chaque fois ?
Récupérer chaque valeur de la boucle dans des cellules puis les récupérer dans une seule variable ?

Peut-être avec ce

Code:

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
Sub test()
  Dim Fichier As FileDialog
  Dim strFilePath As String
  Dim str As String, rep As String
  Dim Lien, I%
  Dim MyData As New DataObject
  Dim Message$
 
    'Sélection du fichier
    Set Fichier = Application.FileDialog(msoFileDialogOpen)
    With Fichier
        .Title = "Sélectionnez le fichier pour générer le lien Internet"
        .InitialFileName = "\\serveur\Partage\"
        .AllowMultiSelect = True
        .Show
    End With
 
    'Extraction du nom de fichier
    For I = 1 To Fichier.SelectedItems.Count
       str = Fichier.SelectedItems(I)
       rep = Mid(str, InStrRev(str, "\") + 1)
       Debug.Print rep
 
      'Formatage du lien http
       Lien = Lien & "http://extranet.fr/Partage/" & rep & vbNewLine
       Message = Message & "Le lien du fichier suivant a bien été copié : " & rep & vbNewLine
    Next I
    'Copie du lien dans le presse-papier
    MyData.SetText Lien
    MyData.PutInClipboard
 
    'Message copie réussie
    'Message = "Le lien du fichier suivant a bien été copié : " & rep
    MsgBox Message, vbInformation, "Lien copié avec succès"
End Sub

28/09/2015, 13h25
keenawy

Merci, la modification fonctionne très bien :)