Remonter d'infos de fichiers dans Excel par VBS

[Résolu]
Signaler
Messages postés
2
Date d'inscription
lundi 10 janvier 2005
Statut
Membre
Dernière intervention
6 décembre 2010
-
Messages postés
2
Date d'inscription
lundi 10 janvier 2005
Statut
Membre
Dernière intervention
6 décembre 2010
-
Bonjour,
Je viens vous demander de l'aide car je suis a cours d'idées. Le langauge VBS a été choisie pour ce script
Voila ma problématique (a priorie assé simple).
     - lecture d'un repertoire (ce repertoire ne doit contenir que des fichiers .doc),
     - remonter des infos suivantes dans un fichier Excel (plus mise en forme du fhichier Excel) :
          - nom du fichier, (ok)
          - date de création du fichier, (ok)
     - dans ce fichier Excel :
          - création d'un liens hypertexte sur les nom de fichiers, qui pointe sur le fichier .doc
          - remonter d'une ligne du fichier Word.

Je bloque sur la c réation des liens hypertexte et sur la lecture du .doc.
Mes recherches sur le net n'ont pas été fructueuses...

Toutes vos propositions seront les bienvenues.

Voici le script :

======================
'Definir variables
Dim Xlapp, Wdapp, Classeur, Feuille, WdDoc, Drive, NomRepertoire, Path, NumLign, MessRAS, Titre
'Initialier variables
Computer = "."
Drive = "Lecteur"
NomRepertoire = "NomRep"
Path = "\" & NomRepertoire & "\"
MessRAS = "Pas de fichiers dans le répertoire " & Drive & "" & NomRepertoire & " OU répertoire inexistant."
Titre = "Titre du scripe"
NumLign = 2


'Initialisation de l'objet Excel.Application
Set Xlapp = CreateObject("Excel.Application")
Xlapp.Visible = True
Set Classeur = Xlapp.Workbooks.add
Set Feuille = Xlapp.ActiveSheet


'Formatage de la feuille Excel
'Colonne A
Feuille.Columns("A:A").ColumnWidth = 40          'Definir largueur colonne
Feuille.Range("A1") = "Nom du fichier"                'Nom de la colonne
Feuille.Range("A1").Font.Color = -16711681      'Couleur du texte
Feuille.Range("A1").Font.Bold = True                  'Texte en gras
Feuille.Range("A1").Interior.ColorIndex = 13        'Couleur de la cellule
'Colonne B
Feuille.Columns("B:B").ColumnWidth = 40           'Definir largueur colonne
Feuille.Range("B1") = "Date de création"              'Nom de la colonne
Feuille.Range("B1").Font.Color = -16711681      'Couleur du texte
Feuille.Range("B1").Font.Bold = True                  'Texte en gras
Feuille.Range("B1").Interior.ColorIndex = 13       'Couleur de la cellule
'Colonne C
Feuille.Columns("C:C").ColumnWidth = 40          'Definir largueur colonne
Feuille.Range("C1") = "Auteur"                            'Nom de la colonne
Feuille.Range("C1").Font.Color = -16711681      'Couleur du texte
Feuille.Range("C1").Font.Bold = True                  'Texte en gras
Feuille.Range("C1").Interior.ColorIndex = 13      'Couleur de la cellule


'Initialisation Objets
Set objWMIService = GetObject("winmgmts:\" & Computer & "\root\cimv2")
Set colFiles = objWMIService.ExecQuery _    ("Select * From CIM_DataFile Where Drive '" & Drive & "'" & "And Path '" & Path & "'")


'Traiter le dossier
If colFiles.Count <> 0 Then
    For Each objFile in colFiles
        Feuille.Range("A" & NumLign) = objFile.FileName
        Feuille.Range("B" & NumLign) = Left (fnConversionDate(objFile.LastModified), 10)
        NumLign = NumLign + 1
    Next
Else
   MsgBox MessRAS, vbokOnly + vbExclamation, Titre
   wscript.quit
End If


Set objWMIService = Nothing
Set colFiles = Nothing


'Function de convertion de date
Function fnConversionDate(strDateUTC)
    fnConversionDate = Mid(strDateUTC, 7, 2) & "/" & Mid(strDateUTC, 5, 2) & "/" & _
                       Left(strDateUTC, 4) & " " & Mid(strDateUTC, 9, 2) & ":" & _
                       Mid(strDateUTC, 11, 2) & ":" & Mid(strDateUTC, 13, 2)
End Function


'Classeur.Saveas "c:\MonClasseur"  'Sauver le classeur sous...
'classeur.Close True               'Quitter le classeur en sauvant
'xlApp.quit                        'Quitter l'application Excel
'Set classeur = Nothing
'Set xlapp = Nothing


'Message de fin de programme
MsgBox "La remontée des noms de fichier du répertoire " _
      & Drive & "" & NomRepertoire & " est terminée", vbokOnly + vbExclamation, Titre


'Quitter le VBScript
wscript.quit

'Traiter le dossier

======================
Merci à vous.

2 réponses

Messages postés
7
Date d'inscription
dimanche 1 août 2004
Statut
Membre
Dernière intervention
30 septembre 2008

bonjour,


tu peux essayer de voir du coté de :




ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Range("A4"), 

Address:="http://www.apple.com/", ScreenTip:="http://www.apple.com/"




pour le lien hypertext (la c'est du vba ... je sais pas si c'est la même chose en vbs)
Messages postés
2
Date d'inscription
lundi 10 janvier 2005
Statut
Membre
Dernière intervention
6 décembre 2010

En vbs la commande n'est pas la même qu'en vba (excel)
Merci pour la reponse Neologo91.