Bonjour
Pour lister des fichiers:
http://dj.joss.free.fr/fichier.htm#dossier4
Daniel
"BlackStorm" a écrit dans le message de news:
#
| Bonjour,
|
| Je travaille sur plusieurs gros disques reseaux sur lesquels je gére de
la
| doc (fichier excel, word, txt, eml.....). J'essai de regrouper par theme
les
| differents documents dans différents repertoires sur 2 disques
principaux
| F: et G:.
|
| Or mes collégues enregistrent des docs un peu partout, créeant des
| repertoires à la volée.(Mon admin refuse de limiter les la creation de
| repertoire et de doc).
|
| Je desirerai
| 1er)sous Excel, repertorier l'enesmble des documents contenu sur les
| disques, par repertoire , les archiver sur une feuille.
| 2eme) Faire une recherche sur un document et avoir automatiquement le
lien
| pour l'ouverture. Cad, aue j'aurai dans une feuille contenant une liste
de
| lien
| f:Espace Document Techniquecahier des chargesgestion solution.doc
| je voudrais que ce lien puisse etre activé et que le document soit
ouvert
| directement par l'application necessaire. Et cela pour l'ensemble des
| documents (doc, xls, pdf, ppm,eml....)
| Apres quoi je ferai un rapport d'impression pour que chacun puisse
savoir ou
| son stocker les documents necessaires soit un volume de plusieurs
milliers !
| Si vous avez une solution, je suis preneur !
|
| Merci d'avance !
|
|
|
|
Bonjour
Pour lister des fichiers:
http://dj.joss.free.fr/fichier.htm#dossier4
Daniel
"BlackStorm" <BlackStorm@Hotmail.com> a écrit dans le message de news:
#rV8KtR7DHA.488@TK2MSFTNGP12.phx.gbl...
| Bonjour,
|
| Je travaille sur plusieurs gros disques reseaux sur lesquels je gére de
la
| doc (fichier excel, word, txt, eml.....). J'essai de regrouper par theme
les
| differents documents dans différents repertoires sur 2 disques
principaux
| F: et G:.
|
| Or mes collégues enregistrent des docs un peu partout, créeant des
| repertoires à la volée.(Mon admin refuse de limiter les la creation de
| repertoire et de doc).
|
| Je desirerai
| 1er)sous Excel, repertorier l'enesmble des documents contenu sur les
| disques, par repertoire , les archiver sur une feuille.
| 2eme) Faire une recherche sur un document et avoir automatiquement le
lien
| pour l'ouverture. Cad, aue j'aurai dans une feuille contenant une liste
de
| lien
| f:Espace Document Techniquecahier des chargesgestion solution.doc
| je voudrais que ce lien puisse etre activé et que le document soit
ouvert
| directement par l'application necessaire. Et cela pour l'ensemble des
| documents (doc, xls, pdf, ppm,eml....)
| Apres quoi je ferai un rapport d'impression pour que chacun puisse
savoir ou
| son stocker les documents necessaires soit un volume de plusieurs
milliers !
| Si vous avez une solution, je suis preneur !
|
| Merci d'avance !
|
|
|
|
Bonjour
Pour lister des fichiers:
http://dj.joss.free.fr/fichier.htm#dossier4
Daniel
"BlackStorm" a écrit dans le message de news:
#
| Bonjour,
|
| Je travaille sur plusieurs gros disques reseaux sur lesquels je gére de
la
| doc (fichier excel, word, txt, eml.....). J'essai de regrouper par theme
les
| differents documents dans différents repertoires sur 2 disques
principaux
| F: et G:.
|
| Or mes collégues enregistrent des docs un peu partout, créeant des
| repertoires à la volée.(Mon admin refuse de limiter les la creation de
| repertoire et de doc).
|
| Je desirerai
| 1er)sous Excel, repertorier l'enesmble des documents contenu sur les
| disques, par repertoire , les archiver sur une feuille.
| 2eme) Faire une recherche sur un document et avoir automatiquement le
lien
| pour l'ouverture. Cad, aue j'aurai dans une feuille contenant une liste
de
| lien
| f:Espace Document Techniquecahier des chargesgestion solution.doc
| je voudrais que ce lien puisse etre activé et que le document soit
ouvert
| directement par l'application necessaire. Et cela pour l'ensemble des
| documents (doc, xls, pdf, ppm,eml....)
| Apres quoi je ferai un rapport d'impression pour que chacun puisse
savoir ou
| son stocker les documents necessaires soit un volume de plusieurs
milliers !
| Si vous avez une solution, je suis preneur !
|
| Merci d'avance !
|
|
|
|
Bonjour,
Je travaille sur plusieurs gros disques reseaux sur lesquels je gére de la
doc (fichier excel, word, txt, eml.....). J'essai de regrouper par theme
les
differents documents dans différents repertoires sur 2 disques principaux
F: et G:.
Or mes collégues enregistrent des docs un peu partout, créeant des
repertoires à la volée.(Mon admin refuse de limiter les la creation de
repertoire et de doc).
Je desirerai
1er)sous Excel, repertorier l'enesmble des documents contenu sur les
disques, par repertoire , les archiver sur une feuille.
2eme) Faire une recherche sur un document et avoir automatiquement le lien
pour l'ouverture. Cad, aue j'aurai dans une feuille contenant une liste de
lien
f:Espace Document Techniquecahier des chargesgestion solution.doc
je voudrais que ce lien puisse etre activé et que le document soit ouvert
directement par l'application necessaire. Et cela pour l'ensemble des
documents (doc, xls, pdf, ppm,eml....)
Apres quoi je ferai un rapport d'impression pour que chacun puisse savoir
ou
son stocker les documents necessaires soit un volume de plusieurs milliers
!
Si vous avez une solution, je suis preneur !
Merci d'avance !
Bonjour,
Je travaille sur plusieurs gros disques reseaux sur lesquels je gére de la
doc (fichier excel, word, txt, eml.....). J'essai de regrouper par theme
les
differents documents dans différents repertoires sur 2 disques principaux
F: et G:.
Or mes collégues enregistrent des docs un peu partout, créeant des
repertoires à la volée.(Mon admin refuse de limiter les la creation de
repertoire et de doc).
Je desirerai
1er)sous Excel, repertorier l'enesmble des documents contenu sur les
disques, par repertoire , les archiver sur une feuille.
2eme) Faire une recherche sur un document et avoir automatiquement le lien
pour l'ouverture. Cad, aue j'aurai dans une feuille contenant une liste de
lien
f:Espace Document Techniquecahier des chargesgestion solution.doc
je voudrais que ce lien puisse etre activé et que le document soit ouvert
directement par l'application necessaire. Et cela pour l'ensemble des
documents (doc, xls, pdf, ppm,eml....)
Apres quoi je ferai un rapport d'impression pour que chacun puisse savoir
ou
son stocker les documents necessaires soit un volume de plusieurs milliers
!
Si vous avez une solution, je suis preneur !
Merci d'avance !
Bonjour,
Je travaille sur plusieurs gros disques reseaux sur lesquels je gére de la
doc (fichier excel, word, txt, eml.....). J'essai de regrouper par theme
les
differents documents dans différents repertoires sur 2 disques principaux
F: et G:.
Or mes collégues enregistrent des docs un peu partout, créeant des
repertoires à la volée.(Mon admin refuse de limiter les la creation de
repertoire et de doc).
Je desirerai
1er)sous Excel, repertorier l'enesmble des documents contenu sur les
disques, par repertoire , les archiver sur une feuille.
2eme) Faire une recherche sur un document et avoir automatiquement le lien
pour l'ouverture. Cad, aue j'aurai dans une feuille contenant une liste de
lien
f:Espace Document Techniquecahier des chargesgestion solution.doc
je voudrais que ce lien puisse etre activé et que le document soit ouvert
directement par l'application necessaire. Et cela pour l'ensemble des
documents (doc, xls, pdf, ppm,eml....)
Apres quoi je ferai un rapport d'impression pour que chacun puisse savoir
ou
son stocker les documents necessaires soit un volume de plusieurs milliers
!
Si vous avez une solution, je suis preneur !
Merci d'avance !
Bonjour BlackStorm.
Voici comment obtenir la liste des documents des types sélectionnés. Et
comment ouvrir le document dont le chemin se trouve dans la cellule
sélectionnée avec le programme approprié.
Option Explicit
Dim nbrFichier As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Const SW_SHOWNORMAL As Long = 1
Private Const SW_SHOWMAXIMIZED As Long = 3
Private Const SW_SHOWDEFAULT As Long = 10
Private Const SE_ERR_NOASSOC As Long = 31
Private Sub CommandButton1_Click()
'obtenir la liste des documents des types sélectionnés
Dim strExtension As String
strExtension = ".txt .mdb .xls .doc .xls .pdf .ppm .eml "
strExtension = Trim(UCase(strExtension)) & " "
Call DirRep("c:", strExtension)
End Sub
Private Sub CommandButton2_Click()
' ouvrir le document dont le chemin se trouve dans la cellule sélectionnée
avec le programme approprié.
Dim Chemin As String
Chemin = Trim(ActiveCell.Value)
If Chemin <> "" Then
Call RunShellExecute(Chemin)
End If
End Sub
Private Sub RunShellExecute(Chemin)
Dim hWndDesk As Long
Dim success As Long
Dim sfile As String
'fichier à ouvrir, qu'importe le type:
sfile = Chemin
hWndDesk = GetDesktopWindow()
success = ShellExecute(hWndDesk, "Open", _
sfile, 0&, 0&, SW_SHOWNORMAL)
End Sub
Private Sub DirRep(NomRep As String, strExtention As String)
Dim Dossiers As New Collection
Dim NomFic As String
Dim i As Integer
If Right(NomRep, 1) <> "" Then NomRep = NomRep & ""
NomFic = Dir(NomRep & "*.*", vbNormal Or vbDirectory)
While NomFic <> ""
If (GetAttr(NomRep & NomFic) And vbDirectory) = vbDirectory Then
If (NomFic <> ".") And (NomFic <> "..") Then
Dossiers.Add NomRep & NomFic
End If
Else
Dim extension As String
If InStr(NomFic, ".") > 0 Then
extension = NomFic
While InStr(extension, ".")
extension = Mid(extension, InStr(extension, ".") + 1)
Wend
extension = "." & UCase(extension) & " "
If InStr(strExtention, extension) > 0 Then
nbrFichier = nbrFichier + 1
Sheets("Feuil1").Cells(nbrFichier, 1).Value = NomRep & NomFic
End If
End If
End If
NomFic = Dir
Wend
' Appel récursif de la même fonction pour traiter les sous-répertoires
While Dossiers.Count > 0
DirRep Dossiers(1), strExtention
Dossiers.Remove 1
Wend
End Sub
"BlackStorm" wrote in message
news:#Bonjour,
Je travaille sur plusieurs gros disques reseaux sur lesquels je gére de
la
doc (fichier excel, word, txt, eml.....). J'essai de regrouper par theme
lesdifferents documents dans différents repertoires sur 2 disques
principaux
F: et G:.
Or mes collégues enregistrent des docs un peu partout, créeant des
repertoires à la volée.(Mon admin refuse de limiter les la creation de
repertoire et de doc).
Je desirerai
1er)sous Excel, repertorier l'enesmble des documents contenu sur les
disques, par repertoire , les archiver sur une feuille.
2eme) Faire une recherche sur un document et avoir automatiquement le
lien
pour l'ouverture. Cad, aue j'aurai dans une feuille contenant une liste
de
lien
f:Espace Document Techniquecahier des chargesgestion solution.doc
je voudrais que ce lien puisse etre activé et que le document soit
ouvert
directement par l'application necessaire. Et cela pour l'ensemble des
documents (doc, xls, pdf, ppm,eml....)
Pour ouvrir un document avec l'application nécessaire:
Option Explicit
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Const SW_SHOWNORMAL As Long = 1
Private Const SW_SHOWMAXIMIZED As Long = 3
Private Const SW_SHOWDEFAULT As Long = 10
Private Const SE_ERR_NOASSOC As Long = 31
Public Sub RunShellExecute(path)
Dim hWndDesk As Long
Dim success As Long
Dim sfile As String
'fichier à ouvrir, qu'importe le type:
sfile = path
hWndDesk = GetDesktopWindow()
success = ShellExecute(hWndDesk, "Open", _
sfile, 0&, 0&, SW_SHOWNORMAL)
End SubApres quoi je ferai un rapport d'impression pour que chacun puisse
savoir
ouson stocker les documents necessaires soit un volume de plusieurs
milliers
!Si vous avez une solution, je suis preneur !
Merci d'avance !
Bonjour BlackStorm.
Voici comment obtenir la liste des documents des types sélectionnés. Et
comment ouvrir le document dont le chemin se trouve dans la cellule
sélectionnée avec le programme approprié.
Option Explicit
Dim nbrFichier As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Const SW_SHOWNORMAL As Long = 1
Private Const SW_SHOWMAXIMIZED As Long = 3
Private Const SW_SHOWDEFAULT As Long = 10
Private Const SE_ERR_NOASSOC As Long = 31
Private Sub CommandButton1_Click()
'obtenir la liste des documents des types sélectionnés
Dim strExtension As String
strExtension = ".txt .mdb .xls .doc .xls .pdf .ppm .eml "
strExtension = Trim(UCase(strExtension)) & " "
Call DirRep("c:", strExtension)
End Sub
Private Sub CommandButton2_Click()
' ouvrir le document dont le chemin se trouve dans la cellule sélectionnée
avec le programme approprié.
Dim Chemin As String
Chemin = Trim(ActiveCell.Value)
If Chemin <> "" Then
Call RunShellExecute(Chemin)
End If
End Sub
Private Sub RunShellExecute(Chemin)
Dim hWndDesk As Long
Dim success As Long
Dim sfile As String
'fichier à ouvrir, qu'importe le type:
sfile = Chemin
hWndDesk = GetDesktopWindow()
success = ShellExecute(hWndDesk, "Open", _
sfile, 0&, 0&, SW_SHOWNORMAL)
End Sub
Private Sub DirRep(NomRep As String, strExtention As String)
Dim Dossiers As New Collection
Dim NomFic As String
Dim i As Integer
If Right(NomRep, 1) <> "" Then NomRep = NomRep & ""
NomFic = Dir(NomRep & "*.*", vbNormal Or vbDirectory)
While NomFic <> ""
If (GetAttr(NomRep & NomFic) And vbDirectory) = vbDirectory Then
If (NomFic <> ".") And (NomFic <> "..") Then
Dossiers.Add NomRep & NomFic
End If
Else
Dim extension As String
If InStr(NomFic, ".") > 0 Then
extension = NomFic
While InStr(extension, ".")
extension = Mid(extension, InStr(extension, ".") + 1)
Wend
extension = "." & UCase(extension) & " "
If InStr(strExtention, extension) > 0 Then
nbrFichier = nbrFichier + 1
Sheets("Feuil1").Cells(nbrFichier, 1).Value = NomRep & NomFic
End If
End If
End If
NomFic = Dir
Wend
' Appel récursif de la même fonction pour traiter les sous-répertoires
While Dossiers.Count > 0
DirRep Dossiers(1), strExtention
Dossiers.Remove 1
Wend
End Sub
"BlackStorm" <BlackStorm@Hotmail.com> wrote in message
news:#rV8KtR7DHA.488@TK2MSFTNGP12.phx.gbl...
Bonjour,
Je travaille sur plusieurs gros disques reseaux sur lesquels je gére de
la
doc (fichier excel, word, txt, eml.....). J'essai de regrouper par theme
les
differents documents dans différents repertoires sur 2 disques
principaux
F: et G:.
Or mes collégues enregistrent des docs un peu partout, créeant des
repertoires à la volée.(Mon admin refuse de limiter les la creation de
repertoire et de doc).
Je desirerai
1er)sous Excel, repertorier l'enesmble des documents contenu sur les
disques, par repertoire , les archiver sur une feuille.
2eme) Faire une recherche sur un document et avoir automatiquement le
lien
pour l'ouverture. Cad, aue j'aurai dans une feuille contenant une liste
de
lien
f:Espace Document Techniquecahier des chargesgestion solution.doc
je voudrais que ce lien puisse etre activé et que le document soit
ouvert
directement par l'application necessaire. Et cela pour l'ensemble des
documents (doc, xls, pdf, ppm,eml....)
Pour ouvrir un document avec l'application nécessaire:
Option Explicit
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Const SW_SHOWNORMAL As Long = 1
Private Const SW_SHOWMAXIMIZED As Long = 3
Private Const SW_SHOWDEFAULT As Long = 10
Private Const SE_ERR_NOASSOC As Long = 31
Public Sub RunShellExecute(path)
Dim hWndDesk As Long
Dim success As Long
Dim sfile As String
'fichier à ouvrir, qu'importe le type:
sfile = path
hWndDesk = GetDesktopWindow()
success = ShellExecute(hWndDesk, "Open", _
sfile, 0&, 0&, SW_SHOWNORMAL)
End Sub
Apres quoi je ferai un rapport d'impression pour que chacun puisse
savoir
ou
son stocker les documents necessaires soit un volume de plusieurs
milliers
!
Si vous avez une solution, je suis preneur !
Merci d'avance !
Bonjour BlackStorm.
Voici comment obtenir la liste des documents des types sélectionnés. Et
comment ouvrir le document dont le chemin se trouve dans la cellule
sélectionnée avec le programme approprié.
Option Explicit
Dim nbrFichier As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Const SW_SHOWNORMAL As Long = 1
Private Const SW_SHOWMAXIMIZED As Long = 3
Private Const SW_SHOWDEFAULT As Long = 10
Private Const SE_ERR_NOASSOC As Long = 31
Private Sub CommandButton1_Click()
'obtenir la liste des documents des types sélectionnés
Dim strExtension As String
strExtension = ".txt .mdb .xls .doc .xls .pdf .ppm .eml "
strExtension = Trim(UCase(strExtension)) & " "
Call DirRep("c:", strExtension)
End Sub
Private Sub CommandButton2_Click()
' ouvrir le document dont le chemin se trouve dans la cellule sélectionnée
avec le programme approprié.
Dim Chemin As String
Chemin = Trim(ActiveCell.Value)
If Chemin <> "" Then
Call RunShellExecute(Chemin)
End If
End Sub
Private Sub RunShellExecute(Chemin)
Dim hWndDesk As Long
Dim success As Long
Dim sfile As String
'fichier à ouvrir, qu'importe le type:
sfile = Chemin
hWndDesk = GetDesktopWindow()
success = ShellExecute(hWndDesk, "Open", _
sfile, 0&, 0&, SW_SHOWNORMAL)
End Sub
Private Sub DirRep(NomRep As String, strExtention As String)
Dim Dossiers As New Collection
Dim NomFic As String
Dim i As Integer
If Right(NomRep, 1) <> "" Then NomRep = NomRep & ""
NomFic = Dir(NomRep & "*.*", vbNormal Or vbDirectory)
While NomFic <> ""
If (GetAttr(NomRep & NomFic) And vbDirectory) = vbDirectory Then
If (NomFic <> ".") And (NomFic <> "..") Then
Dossiers.Add NomRep & NomFic
End If
Else
Dim extension As String
If InStr(NomFic, ".") > 0 Then
extension = NomFic
While InStr(extension, ".")
extension = Mid(extension, InStr(extension, ".") + 1)
Wend
extension = "." & UCase(extension) & " "
If InStr(strExtention, extension) > 0 Then
nbrFichier = nbrFichier + 1
Sheets("Feuil1").Cells(nbrFichier, 1).Value = NomRep & NomFic
End If
End If
End If
NomFic = Dir
Wend
' Appel récursif de la même fonction pour traiter les sous-répertoires
While Dossiers.Count > 0
DirRep Dossiers(1), strExtention
Dossiers.Remove 1
Wend
End Sub
"BlackStorm" wrote in message
news:#Bonjour,
Je travaille sur plusieurs gros disques reseaux sur lesquels je gére de
la
doc (fichier excel, word, txt, eml.....). J'essai de regrouper par theme
lesdifferents documents dans différents repertoires sur 2 disques
principaux
F: et G:.
Or mes collégues enregistrent des docs un peu partout, créeant des
repertoires à la volée.(Mon admin refuse de limiter les la creation de
repertoire et de doc).
Je desirerai
1er)sous Excel, repertorier l'enesmble des documents contenu sur les
disques, par repertoire , les archiver sur une feuille.
2eme) Faire une recherche sur un document et avoir automatiquement le
lien
pour l'ouverture. Cad, aue j'aurai dans une feuille contenant une liste
de
lien
f:Espace Document Techniquecahier des chargesgestion solution.doc
je voudrais que ce lien puisse etre activé et que le document soit
ouvert
directement par l'application necessaire. Et cela pour l'ensemble des
documents (doc, xls, pdf, ppm,eml....)
Pour ouvrir un document avec l'application nécessaire:
Option Explicit
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Const SW_SHOWNORMAL As Long = 1
Private Const SW_SHOWMAXIMIZED As Long = 3
Private Const SW_SHOWDEFAULT As Long = 10
Private Const SE_ERR_NOASSOC As Long = 31
Public Sub RunShellExecute(path)
Dim hWndDesk As Long
Dim success As Long
Dim sfile As String
'fichier à ouvrir, qu'importe le type:
sfile = path
hWndDesk = GetDesktopWindow()
success = ShellExecute(hWndDesk, "Open", _
sfile, 0&, 0&, SW_SHOWNORMAL)
End SubApres quoi je ferai un rapport d'impression pour que chacun puisse
savoir
ouson stocker les documents necessaires soit un volume de plusieurs
milliers
!Si vous avez une solution, je suis preneur !
Merci d'avance !
Merci,
Mais... ca ne fonctionne pas j'ai une erreur de complilation :
Private Declare Function GetDesktopWindow Lib "user32" () As Long
merci en tout cas pour ton aide mais si tu pouvais encore m'aider la !?
"docmarti" a écrit dans le message de news:Bonjour BlackStorm.
Voici comment obtenir la liste des documents des types sélectionnés. Et
comment ouvrir le document dont le chemin se trouve dans la cellule
sélectionnée avec le programme approprié.
Option Explicit
Dim nbrFichier As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Const SW_SHOWNORMAL As Long = 1
Private Const SW_SHOWMAXIMIZED As Long = 3
Private Const SW_SHOWDEFAULT As Long = 10
Private Const SE_ERR_NOASSOC As Long = 31
Private Sub CommandButton1_Click()
'obtenir la liste des documents des types sélectionnés
Dim strExtension As String
strExtension = ".txt .mdb .xls .doc .xls .pdf .ppm .eml "
strExtension = Trim(UCase(strExtension)) & " "
Call DirRep("c:", strExtension)
End Sub
Private Sub CommandButton2_Click()
' ouvrir le document dont le chemin se trouve dans la cellule
sélectionnée
avec le programme approprié.
Dim Chemin As String
Chemin = Trim(ActiveCell.Value)
If Chemin <> "" Then
Call RunShellExecute(Chemin)
End If
End Sub
Private Sub RunShellExecute(Chemin)
Dim hWndDesk As Long
Dim success As Long
Dim sfile As String
'fichier à ouvrir, qu'importe le type:
sfile = Chemin
hWndDesk = GetDesktopWindow()
success = ShellExecute(hWndDesk, "Open", _
sfile, 0&, 0&, SW_SHOWNORMAL)
End Sub
Private Sub DirRep(NomRep As String, strExtention As String)
Dim Dossiers As New Collection
Dim NomFic As String
Dim i As Integer
If Right(NomRep, 1) <> "" Then NomRep = NomRep & ""
NomFic = Dir(NomRep & "*.*", vbNormal Or vbDirectory)
While NomFic <> ""
If (GetAttr(NomRep & NomFic) And vbDirectory) = vbDirectory Then
If (NomFic <> ".") And (NomFic <> "..") Then
Dossiers.Add NomRep & NomFic
End If
Else
Dim extension As String
If InStr(NomFic, ".") > 0 Then
extension = NomFic
While InStr(extension, ".")
extension = Mid(extension, InStr(extension, ".") + 1)
Wend
extension = "." & UCase(extension) & " "
If InStr(strExtention, extension) > 0 Then
nbrFichier = nbrFichier + 1
Sheets("Feuil1").Cells(nbrFichier, 1).Value = NomRep &
NomFic
End If
End If
End If
NomFic = Dir
Wend
' Appel récursif de la même fonction pour traiter les
sous-répertoires
While Dossiers.Count > 0
DirRep Dossiers(1), strExtention
Dossiers.Remove 1
Wend
End Sub
"BlackStorm" wrote in message
news:#Bonjour,
Je travaille sur plusieurs gros disques reseaux sur lesquels je gére
de
ladoc (fichier excel, word, txt, eml.....). J'essai de regrouper par
theme
lesdifferents documents dans différents repertoires sur 2 disques
principauxF: et G:.
Or mes collégues enregistrent des docs un peu partout, créeant des
repertoires à la volée.(Mon admin refuse de limiter les la creation de
repertoire et de doc).
Je desirerai
1er)sous Excel, repertorier l'enesmble des documents contenu sur les
disques, par repertoire , les archiver sur une feuille.
2eme) Faire une recherche sur un document et avoir automatiquement le
lienpour l'ouverture. Cad, aue j'aurai dans une feuille contenant une
liste
delien
f:Espace Document Techniquecahier des chargesgestion solution.doc
je voudrais que ce lien puisse etre activé et que le document soit
ouvertdirectement par l'application necessaire. Et cela pour l'ensemble des
documents (doc, xls, pdf, ppm,eml....)
Pour ouvrir un document avec l'application nécessaire:
Option Explicit
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Const SW_SHOWNORMAL As Long = 1
Private Const SW_SHOWMAXIMIZED As Long = 3
Private Const SW_SHOWDEFAULT As Long = 10
Private Const SE_ERR_NOASSOC As Long = 31
Public Sub RunShellExecute(path)
Dim hWndDesk As Long
Dim success As Long
Dim sfile As String
'fichier à ouvrir, qu'importe le type:
sfile = path
hWndDesk = GetDesktopWindow()
success = ShellExecute(hWndDesk, "Open", _
sfile, 0&, 0&, SW_SHOWNORMAL)
End SubApres quoi je ferai un rapport d'impression pour que chacun puisse
savoirouson stocker les documents necessaires soit un volume de plusieurs
milliers!Si vous avez une solution, je suis preneur !
Merci d'avance !
Merci,
Mais... ca ne fonctionne pas j'ai une erreur de complilation :
Private Declare Function GetDesktopWindow Lib "user32" () As Long
merci en tout cas pour ton aide mais si tu pouvais encore m'aider la !?
"docmarti" <docmarti@spam.net> a écrit dans le message de news:
u4UMKIW7DHA.712@tk2msftngp13.phx.gbl...
Bonjour BlackStorm.
Voici comment obtenir la liste des documents des types sélectionnés. Et
comment ouvrir le document dont le chemin se trouve dans la cellule
sélectionnée avec le programme approprié.
Option Explicit
Dim nbrFichier As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Const SW_SHOWNORMAL As Long = 1
Private Const SW_SHOWMAXIMIZED As Long = 3
Private Const SW_SHOWDEFAULT As Long = 10
Private Const SE_ERR_NOASSOC As Long = 31
Private Sub CommandButton1_Click()
'obtenir la liste des documents des types sélectionnés
Dim strExtension As String
strExtension = ".txt .mdb .xls .doc .xls .pdf .ppm .eml "
strExtension = Trim(UCase(strExtension)) & " "
Call DirRep("c:", strExtension)
End Sub
Private Sub CommandButton2_Click()
' ouvrir le document dont le chemin se trouve dans la cellule
sélectionnée
avec le programme approprié.
Dim Chemin As String
Chemin = Trim(ActiveCell.Value)
If Chemin <> "" Then
Call RunShellExecute(Chemin)
End If
End Sub
Private Sub RunShellExecute(Chemin)
Dim hWndDesk As Long
Dim success As Long
Dim sfile As String
'fichier à ouvrir, qu'importe le type:
sfile = Chemin
hWndDesk = GetDesktopWindow()
success = ShellExecute(hWndDesk, "Open", _
sfile, 0&, 0&, SW_SHOWNORMAL)
End Sub
Private Sub DirRep(NomRep As String, strExtention As String)
Dim Dossiers As New Collection
Dim NomFic As String
Dim i As Integer
If Right(NomRep, 1) <> "" Then NomRep = NomRep & ""
NomFic = Dir(NomRep & "*.*", vbNormal Or vbDirectory)
While NomFic <> ""
If (GetAttr(NomRep & NomFic) And vbDirectory) = vbDirectory Then
If (NomFic <> ".") And (NomFic <> "..") Then
Dossiers.Add NomRep & NomFic
End If
Else
Dim extension As String
If InStr(NomFic, ".") > 0 Then
extension = NomFic
While InStr(extension, ".")
extension = Mid(extension, InStr(extension, ".") + 1)
Wend
extension = "." & UCase(extension) & " "
If InStr(strExtention, extension) > 0 Then
nbrFichier = nbrFichier + 1
Sheets("Feuil1").Cells(nbrFichier, 1).Value = NomRep &
NomFic
End If
End If
End If
NomFic = Dir
Wend
' Appel récursif de la même fonction pour traiter les
sous-répertoires
While Dossiers.Count > 0
DirRep Dossiers(1), strExtention
Dossiers.Remove 1
Wend
End Sub
"BlackStorm" <BlackStorm@Hotmail.com> wrote in message
news:#rV8KtR7DHA.488@TK2MSFTNGP12.phx.gbl...
Bonjour,
Je travaille sur plusieurs gros disques reseaux sur lesquels je gére
de
la
doc (fichier excel, word, txt, eml.....). J'essai de regrouper par
theme
les
differents documents dans différents repertoires sur 2 disques
principaux
F: et G:.
Or mes collégues enregistrent des docs un peu partout, créeant des
repertoires à la volée.(Mon admin refuse de limiter les la creation de
repertoire et de doc).
Je desirerai
1er)sous Excel, repertorier l'enesmble des documents contenu sur les
disques, par repertoire , les archiver sur une feuille.
2eme) Faire une recherche sur un document et avoir automatiquement le
lien
pour l'ouverture. Cad, aue j'aurai dans une feuille contenant une
liste
de
lien
f:Espace Document Techniquecahier des chargesgestion solution.doc
je voudrais que ce lien puisse etre activé et que le document soit
ouvert
directement par l'application necessaire. Et cela pour l'ensemble des
documents (doc, xls, pdf, ppm,eml....)
Pour ouvrir un document avec l'application nécessaire:
Option Explicit
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Const SW_SHOWNORMAL As Long = 1
Private Const SW_SHOWMAXIMIZED As Long = 3
Private Const SW_SHOWDEFAULT As Long = 10
Private Const SE_ERR_NOASSOC As Long = 31
Public Sub RunShellExecute(path)
Dim hWndDesk As Long
Dim success As Long
Dim sfile As String
'fichier à ouvrir, qu'importe le type:
sfile = path
hWndDesk = GetDesktopWindow()
success = ShellExecute(hWndDesk, "Open", _
sfile, 0&, 0&, SW_SHOWNORMAL)
End Sub
Apres quoi je ferai un rapport d'impression pour que chacun puisse
savoir
ou
son stocker les documents necessaires soit un volume de plusieurs
milliers
!
Si vous avez une solution, je suis preneur !
Merci d'avance !
Merci,
Mais... ca ne fonctionne pas j'ai une erreur de complilation :
Private Declare Function GetDesktopWindow Lib "user32" () As Long
merci en tout cas pour ton aide mais si tu pouvais encore m'aider la !?
"docmarti" a écrit dans le message de news:Bonjour BlackStorm.
Voici comment obtenir la liste des documents des types sélectionnés. Et
comment ouvrir le document dont le chemin se trouve dans la cellule
sélectionnée avec le programme approprié.
Option Explicit
Dim nbrFichier As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Const SW_SHOWNORMAL As Long = 1
Private Const SW_SHOWMAXIMIZED As Long = 3
Private Const SW_SHOWDEFAULT As Long = 10
Private Const SE_ERR_NOASSOC As Long = 31
Private Sub CommandButton1_Click()
'obtenir la liste des documents des types sélectionnés
Dim strExtension As String
strExtension = ".txt .mdb .xls .doc .xls .pdf .ppm .eml "
strExtension = Trim(UCase(strExtension)) & " "
Call DirRep("c:", strExtension)
End Sub
Private Sub CommandButton2_Click()
' ouvrir le document dont le chemin se trouve dans la cellule
sélectionnée
avec le programme approprié.
Dim Chemin As String
Chemin = Trim(ActiveCell.Value)
If Chemin <> "" Then
Call RunShellExecute(Chemin)
End If
End Sub
Private Sub RunShellExecute(Chemin)
Dim hWndDesk As Long
Dim success As Long
Dim sfile As String
'fichier à ouvrir, qu'importe le type:
sfile = Chemin
hWndDesk = GetDesktopWindow()
success = ShellExecute(hWndDesk, "Open", _
sfile, 0&, 0&, SW_SHOWNORMAL)
End Sub
Private Sub DirRep(NomRep As String, strExtention As String)
Dim Dossiers As New Collection
Dim NomFic As String
Dim i As Integer
If Right(NomRep, 1) <> "" Then NomRep = NomRep & ""
NomFic = Dir(NomRep & "*.*", vbNormal Or vbDirectory)
While NomFic <> ""
If (GetAttr(NomRep & NomFic) And vbDirectory) = vbDirectory Then
If (NomFic <> ".") And (NomFic <> "..") Then
Dossiers.Add NomRep & NomFic
End If
Else
Dim extension As String
If InStr(NomFic, ".") > 0 Then
extension = NomFic
While InStr(extension, ".")
extension = Mid(extension, InStr(extension, ".") + 1)
Wend
extension = "." & UCase(extension) & " "
If InStr(strExtention, extension) > 0 Then
nbrFichier = nbrFichier + 1
Sheets("Feuil1").Cells(nbrFichier, 1).Value = NomRep &
NomFic
End If
End If
End If
NomFic = Dir
Wend
' Appel récursif de la même fonction pour traiter les
sous-répertoires
While Dossiers.Count > 0
DirRep Dossiers(1), strExtention
Dossiers.Remove 1
Wend
End Sub
"BlackStorm" wrote in message
news:#Bonjour,
Je travaille sur plusieurs gros disques reseaux sur lesquels je gére
de
ladoc (fichier excel, word, txt, eml.....). J'essai de regrouper par
theme
lesdifferents documents dans différents repertoires sur 2 disques
principauxF: et G:.
Or mes collégues enregistrent des docs un peu partout, créeant des
repertoires à la volée.(Mon admin refuse de limiter les la creation de
repertoire et de doc).
Je desirerai
1er)sous Excel, repertorier l'enesmble des documents contenu sur les
disques, par repertoire , les archiver sur une feuille.
2eme) Faire une recherche sur un document et avoir automatiquement le
lienpour l'ouverture. Cad, aue j'aurai dans une feuille contenant une
liste
delien
f:Espace Document Techniquecahier des chargesgestion solution.doc
je voudrais que ce lien puisse etre activé et que le document soit
ouvertdirectement par l'application necessaire. Et cela pour l'ensemble des
documents (doc, xls, pdf, ppm,eml....)
Pour ouvrir un document avec l'application nécessaire:
Option Explicit
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Const SW_SHOWNORMAL As Long = 1
Private Const SW_SHOWMAXIMIZED As Long = 3
Private Const SW_SHOWDEFAULT As Long = 10
Private Const SE_ERR_NOASSOC As Long = 31
Public Sub RunShellExecute(path)
Dim hWndDesk As Long
Dim success As Long
Dim sfile As String
'fichier à ouvrir, qu'importe le type:
sfile = path
hWndDesk = GetDesktopWindow()
success = ShellExecute(hWndDesk, "Open", _
sfile, 0&, 0&, SW_SHOWNORMAL)
End SubApres quoi je ferai un rapport d'impression pour que chacun puisse
savoirouson stocker les documents necessaires soit un volume de plusieurs
milliers!Si vous avez une solution, je suis preneur !
Merci d'avance !
Option Explicit
Dim Ligne As Long
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Sub Macro1_RechercherTousLesFichiers()
'Chercher dans un répertoire (la variable Chemin) et ses sous-répertoires
'tous les fichiers de certains types (la variable Extensions)
Dim Extensions As String
Dim Chemin As String
Chemin = "c:"
Extensions = ".txt .mdb .xls .doc .xls .pdf .ppm .eml "
Extensions = Trim(UCase(Extensions)) & " "
Ligne = 0
Call DirRep(Chemin, Extensions)
End Sub
Private Sub Macro2_OuvrirUnDocument()
'Ouvrir avec l'application appropriée le document
'dont le chemin se trouve dans la cellule active
Dim Chemin As String
Chemin = Trim(ActiveCell.Value)
If Chemin <> "" Then
Call RunShellExecute(Chemin)
End If
End Sub
Private Sub DirRep(NomRep As String, strExtention As String)
Dim Dossiers As New Collection
Dim NomFic As String
Dim i As Integer
If Right(NomRep, 1) <> "" Then NomRep = NomRep & ""
NomFic = Dir(NomRep & "*.*", vbNormal Or vbDirectory)
While NomFic <> ""
If (GetAttr(NomRep & NomFic) And vbDirectory) = vbDirectory Then
If (NomFic <> ".") And (NomFic <> "..") Then
Dossiers.Add NomRep & NomFic
End If
Else
Dim extension As String
If InStr(NomFic, ".") > 0 Then
extension = NomFic
While InStr(extension, ".")
extension = Mid(extension, InStr(extension, ".") + 1)
Wend
extension = "." & UCase(extension) & " "
If InStr(strExtention, extension) > 0 Then
Ligne = Ligne + 1
Sheets("Feuil1").Cells(Ligne, 1).Value = NomRep & NomFic
End If
End If
End If
NomFic = Dir
Wend
' Appel récursif de la même fonction pour traiter les sous-répertoires
While Dossiers.Count > 0
DirRep Dossiers(1), strExtention
Dossiers.Remove 1
Wend
End Sub
Private Sub RunShellExecute(Chemin)
ShellExecute 0&, vbNullString, Chemin, vbNullString, _
vbNullString, vbNormalFocus
End Sub
Option Explicit
Dim Ligne As Long
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Sub Macro1_RechercherTousLesFichiers()
'Chercher dans un répertoire (la variable Chemin) et ses sous-répertoires
'tous les fichiers de certains types (la variable Extensions)
Dim Extensions As String
Dim Chemin As String
Chemin = "c:"
Extensions = ".txt .mdb .xls .doc .xls .pdf .ppm .eml "
Extensions = Trim(UCase(Extensions)) & " "
Ligne = 0
Call DirRep(Chemin, Extensions)
End Sub
Private Sub Macro2_OuvrirUnDocument()
'Ouvrir avec l'application appropriée le document
'dont le chemin se trouve dans la cellule active
Dim Chemin As String
Chemin = Trim(ActiveCell.Value)
If Chemin <> "" Then
Call RunShellExecute(Chemin)
End If
End Sub
Private Sub DirRep(NomRep As String, strExtention As String)
Dim Dossiers As New Collection
Dim NomFic As String
Dim i As Integer
If Right(NomRep, 1) <> "" Then NomRep = NomRep & ""
NomFic = Dir(NomRep & "*.*", vbNormal Or vbDirectory)
While NomFic <> ""
If (GetAttr(NomRep & NomFic) And vbDirectory) = vbDirectory Then
If (NomFic <> ".") And (NomFic <> "..") Then
Dossiers.Add NomRep & NomFic
End If
Else
Dim extension As String
If InStr(NomFic, ".") > 0 Then
extension = NomFic
While InStr(extension, ".")
extension = Mid(extension, InStr(extension, ".") + 1)
Wend
extension = "." & UCase(extension) & " "
If InStr(strExtention, extension) > 0 Then
Ligne = Ligne + 1
Sheets("Feuil1").Cells(Ligne, 1).Value = NomRep & NomFic
End If
End If
End If
NomFic = Dir
Wend
' Appel récursif de la même fonction pour traiter les sous-répertoires
While Dossiers.Count > 0
DirRep Dossiers(1), strExtention
Dossiers.Remove 1
Wend
End Sub
Private Sub RunShellExecute(Chemin)
ShellExecute 0&, vbNullString, Chemin, vbNullString, _
vbNullString, vbNormalFocus
End Sub
Option Explicit
Dim Ligne As Long
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Sub Macro1_RechercherTousLesFichiers()
'Chercher dans un répertoire (la variable Chemin) et ses sous-répertoires
'tous les fichiers de certains types (la variable Extensions)
Dim Extensions As String
Dim Chemin As String
Chemin = "c:"
Extensions = ".txt .mdb .xls .doc .xls .pdf .ppm .eml "
Extensions = Trim(UCase(Extensions)) & " "
Ligne = 0
Call DirRep(Chemin, Extensions)
End Sub
Private Sub Macro2_OuvrirUnDocument()
'Ouvrir avec l'application appropriée le document
'dont le chemin se trouve dans la cellule active
Dim Chemin As String
Chemin = Trim(ActiveCell.Value)
If Chemin <> "" Then
Call RunShellExecute(Chemin)
End If
End Sub
Private Sub DirRep(NomRep As String, strExtention As String)
Dim Dossiers As New Collection
Dim NomFic As String
Dim i As Integer
If Right(NomRep, 1) <> "" Then NomRep = NomRep & ""
NomFic = Dir(NomRep & "*.*", vbNormal Or vbDirectory)
While NomFic <> ""
If (GetAttr(NomRep & NomFic) And vbDirectory) = vbDirectory Then
If (NomFic <> ".") And (NomFic <> "..") Then
Dossiers.Add NomRep & NomFic
End If
Else
Dim extension As String
If InStr(NomFic, ".") > 0 Then
extension = NomFic
While InStr(extension, ".")
extension = Mid(extension, InStr(extension, ".") + 1)
Wend
extension = "." & UCase(extension) & " "
If InStr(strExtention, extension) > 0 Then
Ligne = Ligne + 1
Sheets("Feuil1").Cells(Ligne, 1).Value = NomRep & NomFic
End If
End If
End If
NomFic = Dir
Wend
' Appel récursif de la même fonction pour traiter les sous-répertoires
While Dossiers.Count > 0
DirRep Dossiers(1), strExtention
Dossiers.Remove 1
Wend
End Sub
Private Sub RunShellExecute(Chemin)
ShellExecute 0&, vbNullString, Chemin, vbNullString, _
vbNullString, vbNormalFocus
End Sub
Merci en tout cas pour ton aide !
Je t'explique comment je procéde, parce que je suis pas doué !
Je crée une macro que j'arrete immédiatement. Puis je selectionne cette
macro et je passe en mode modification. Et là j'insere les lignes de codes
suivantes.
ET ca ne marche pas.
Je sais que je ne fais pas ce qu'il faut !! Si tu pouvais m'expliquer en
détails je te serai infiniment reconnaissant. Autre chose, les lecteurs que
je veux scanner sont des lecteurs reseau F: et G:
Big merci d'avance.
Merci en tout cas pour ton aide !
Je t'explique comment je procéde, parce que je suis pas doué !
Je crée une macro que j'arrete immédiatement. Puis je selectionne cette
macro et je passe en mode modification. Et là j'insere les lignes de codes
suivantes.
ET ca ne marche pas.
Je sais que je ne fais pas ce qu'il faut !! Si tu pouvais m'expliquer en
détails je te serai infiniment reconnaissant. Autre chose, les lecteurs que
je veux scanner sont des lecteurs reseau F: et G:
Big merci d'avance.
Merci en tout cas pour ton aide !
Je t'explique comment je procéde, parce que je suis pas doué !
Je crée une macro que j'arrete immédiatement. Puis je selectionne cette
macro et je passe en mode modification. Et là j'insere les lignes de codes
suivantes.
ET ca ne marche pas.
Je sais que je ne fais pas ce qu'il faut !! Si tu pouvais m'expliquer en
détails je te serai infiniment reconnaissant. Autre chose, les lecteurs que
je veux scanner sont des lecteurs reseau F: et G:
Big merci d'avance.
Bonjour,
Pas optimisée pour deux sous, ni testée dans ses limitations mais ca
semble marcher. Je te laisse le soin d'adapter les chemins, extensions
(. suivi de 3 caractères), noms de feuille, ...
Sub RecupNomsFichiers()
Application.StatusBar = "Un moment, SVP ..."
Dim arr_disk, Classeurs() As String, i
Dim feuille, extensions, disk, nom, a,cel,cellule,contenu
Set feuille = Sheets("Feuil1")
arr_disk = Array("D: 0", "C:pdf")
extensions = ".xls.doc.eml.pdf.xlm"
For Each disk In arr_disk
If Right(disk, 1) <> "" Then disk = disk & ""
With Application.FileSearch
.NewSearch
.Filename = "*.*"
.LookIn = disk
.SearchSubFolders = True
.Execute
With .FoundFiles
ReDim Classeurs(1 To .Count, 1 To 1)
On Error Resume Next
For I = 1 To .Count
DoEvents
nom = .Item(I)
If I Mod 10 = 0 Then Application.StatusBar = nom
If InStr(1, UCase(extensions), UCase(Right(.Item(I), 4))) > 0 Then
a = a + 1
Classeurs(a, 1) = .Item(I)
End If
Next I
Application.ScreenUpdating = False
cel = feuille.Range("A65536").End(xlUp).Offset(1, 0).Address
With feuille.Range(cel).Resize(a)
.Value = Classeurs
.Sort [A1]
End With
End With
End With
Next disk
With feuille
.Range("A1:" & .Range("A65536").End(xlUp).Address).Select
Selection.Sort [A1]
For Each cel In Selection
cellule = cel.Address
contenu = cel.Value
Range(cellule).ClearContents
ActiveSheet.Hyperlinks.Add Anchor:=Range(cellule), Address:=contenu
Next cel
End With
Application.StatusBar = False
End Sub
Pour info, c'est tiré de ma réponse du 07/02 dans le premier fil que tu
sembles avoir délaissé.
@+
FxM
BlackStorm wrote:Merci en tout cas pour ton aide !
Je t'explique comment je procéde, parce que je suis pas doué !
Je crée une macro que j'arrete immédiatement. Puis je selectionne cette
macro et je passe en mode modification. Et là j'insere les lignes de
codes
suivantes.
ET ca ne marche pas.
Je sais que je ne fais pas ce qu'il faut !! Si tu pouvais m'expliquer en
détails je te serai infiniment reconnaissant. Autre chose, les lecteurs
que
je veux scanner sont des lecteurs reseau F: et G:
Big merci d'avance.
Bonjour,
Pas optimisée pour deux sous, ni testée dans ses limitations mais ca
semble marcher. Je te laisse le soin d'adapter les chemins, extensions
(. suivi de 3 caractères), noms de feuille, ...
Sub RecupNomsFichiers()
Application.StatusBar = "Un moment, SVP ..."
Dim arr_disk, Classeurs() As String, i
Dim feuille, extensions, disk, nom, a,cel,cellule,contenu
Set feuille = Sheets("Feuil1")
arr_disk = Array("D: 0", "C:pdf")
extensions = ".xls.doc.eml.pdf.xlm"
For Each disk In arr_disk
If Right(disk, 1) <> "" Then disk = disk & ""
With Application.FileSearch
.NewSearch
.Filename = "*.*"
.LookIn = disk
.SearchSubFolders = True
.Execute
With .FoundFiles
ReDim Classeurs(1 To .Count, 1 To 1)
On Error Resume Next
For I = 1 To .Count
DoEvents
nom = .Item(I)
If I Mod 10 = 0 Then Application.StatusBar = nom
If InStr(1, UCase(extensions), UCase(Right(.Item(I), 4))) > 0 Then
a = a + 1
Classeurs(a, 1) = .Item(I)
End If
Next I
Application.ScreenUpdating = False
cel = feuille.Range("A65536").End(xlUp).Offset(1, 0).Address
With feuille.Range(cel).Resize(a)
.Value = Classeurs
.Sort [A1]
End With
End With
End With
Next disk
With feuille
.Range("A1:" & .Range("A65536").End(xlUp).Address).Select
Selection.Sort [A1]
For Each cel In Selection
cellule = cel.Address
contenu = cel.Value
Range(cellule).ClearContents
ActiveSheet.Hyperlinks.Add Anchor:=Range(cellule), Address:=contenu
Next cel
End With
Application.StatusBar = False
End Sub
Pour info, c'est tiré de ma réponse du 07/02 dans le premier fil que tu
sembles avoir délaissé.
@+
FxM
BlackStorm wrote:
Merci en tout cas pour ton aide !
Je t'explique comment je procéde, parce que je suis pas doué !
Je crée une macro que j'arrete immédiatement. Puis je selectionne cette
macro et je passe en mode modification. Et là j'insere les lignes de
codes
suivantes.
ET ca ne marche pas.
Je sais que je ne fais pas ce qu'il faut !! Si tu pouvais m'expliquer en
détails je te serai infiniment reconnaissant. Autre chose, les lecteurs
que
je veux scanner sont des lecteurs reseau F: et G:
Big merci d'avance.
Bonjour,
Pas optimisée pour deux sous, ni testée dans ses limitations mais ca
semble marcher. Je te laisse le soin d'adapter les chemins, extensions
(. suivi de 3 caractères), noms de feuille, ...
Sub RecupNomsFichiers()
Application.StatusBar = "Un moment, SVP ..."
Dim arr_disk, Classeurs() As String, i
Dim feuille, extensions, disk, nom, a,cel,cellule,contenu
Set feuille = Sheets("Feuil1")
arr_disk = Array("D: 0", "C:pdf")
extensions = ".xls.doc.eml.pdf.xlm"
For Each disk In arr_disk
If Right(disk, 1) <> "" Then disk = disk & ""
With Application.FileSearch
.NewSearch
.Filename = "*.*"
.LookIn = disk
.SearchSubFolders = True
.Execute
With .FoundFiles
ReDim Classeurs(1 To .Count, 1 To 1)
On Error Resume Next
For I = 1 To .Count
DoEvents
nom = .Item(I)
If I Mod 10 = 0 Then Application.StatusBar = nom
If InStr(1, UCase(extensions), UCase(Right(.Item(I), 4))) > 0 Then
a = a + 1
Classeurs(a, 1) = .Item(I)
End If
Next I
Application.ScreenUpdating = False
cel = feuille.Range("A65536").End(xlUp).Offset(1, 0).Address
With feuille.Range(cel).Resize(a)
.Value = Classeurs
.Sort [A1]
End With
End With
End With
Next disk
With feuille
.Range("A1:" & .Range("A65536").End(xlUp).Address).Select
Selection.Sort [A1]
For Each cel In Selection
cellule = cel.Address
contenu = cel.Value
Range(cellule).ClearContents
ActiveSheet.Hyperlinks.Add Anchor:=Range(cellule), Address:=contenu
Next cel
End With
Application.StatusBar = False
End Sub
Pour info, c'est tiré de ma réponse du 07/02 dans le premier fil que tu
sembles avoir délaissé.
@+
FxM
BlackStorm wrote:Merci en tout cas pour ton aide !
Je t'explique comment je procéde, parce que je suis pas doué !
Je crée une macro que j'arrete immédiatement. Puis je selectionne cette
macro et je passe en mode modification. Et là j'insere les lignes de
codes
suivantes.
ET ca ne marche pas.
Je sais que je ne fais pas ce qu'il faut !! Si tu pouvais m'expliquer en
détails je te serai infiniment reconnaissant. Autre chose, les lecteurs
que
je veux scanner sont des lecteurs reseau F: et G:
Big merci d'avance.
Bonjour,
Pas optimisée pour deux sous, ni testée dans ses limitations mais ca
semble marcher. Je te laisse le soin d'adapter les chemins, extensions
(. suivi de 3 caractères), noms de feuille, ...
Sub RecupNomsFichiers()
Application.StatusBar = "Un moment, SVP ..."
Dim arr_disk, Classeurs() As String, i
Dim feuille, extensions, disk, nom, a,cel,cellule,contenu
Set feuille = Sheets("Feuil1")
arr_disk = Array("D: 0", "C:pdf")
extensions = ".xls.doc.eml.pdf.xlm"
For Each disk In arr_disk
If Right(disk, 1) <> "" Then disk = disk & ""
With Application.FileSearch
.NewSearch
.Filename = "*.*"
.LookIn = disk
.SearchSubFolders = True
.Execute
With .FoundFiles
ReDim Classeurs(1 To .Count, 1 To 1)
On Error Resume Next
For I = 1 To .Count
DoEvents
nom = .Item(I)
If I Mod 10 = 0 Then Application.StatusBar = nom
If InStr(1, UCase(extensions), UCase(Right(.Item(I), 4))) > 0 Then
a = a + 1
Classeurs(a, 1) = .Item(I)
End If
Next I
Application.ScreenUpdating = False
cel = feuille.Range("A65536").End(xlUp).Offset(1, 0).Address
With feuille.Range(cel).Resize(a)
.Value = Classeurs
.Sort [A1]
End With
End With
End With
Next disk
With feuille
.Range("A1:" & .Range("A65536").End(xlUp).Address).Select
Selection.Sort [A1]
For Each cel In Selection
cellule = cel.Address
contenu = cel.Value
Range(cellule).ClearContents
ActiveSheet.Hyperlinks.Add Anchor:=Range(cellule), Address:=contenu
Next cel
End With
Application.StatusBar = False
End Sub
Pour info, c'est tiré de ma réponse du 07/02 dans le premier fil que tu
sembles avoir délaissé.
@+
FxM
BlackStorm wrote:Merci en tout cas pour ton aide !
Je t'explique comment je procéde, parce que je suis pas doué !
Je crée une macro que j'arrete immédiatement. Puis je selectionne cette
macro et je passe en mode modification. Et là j'insere les lignes de
codes
suivantes.
ET ca ne marche pas.
Je sais que je ne fais pas ce qu'il faut !! Si tu pouvais m'expliquer en
détails je te serai infiniment reconnaissant. Autre chose, les lecteurs
que
je veux scanner sont des lecteurs reseau F: et G:
Big merci d'avance.
Bonjour,
Pas optimisée pour deux sous, ni testée dans ses limitations mais ca
semble marcher. Je te laisse le soin d'adapter les chemins, extensions
(. suivi de 3 caractères), noms de feuille, ...
Sub RecupNomsFichiers()
Application.StatusBar = "Un moment, SVP ..."
Dim arr_disk, Classeurs() As String, i
Dim feuille, extensions, disk, nom, a,cel,cellule,contenu
Set feuille = Sheets("Feuil1")
arr_disk = Array("D: 0", "C:pdf")
extensions = ".xls.doc.eml.pdf.xlm"
For Each disk In arr_disk
If Right(disk, 1) <> "" Then disk = disk & ""
With Application.FileSearch
.NewSearch
.Filename = "*.*"
.LookIn = disk
.SearchSubFolders = True
.Execute
With .FoundFiles
ReDim Classeurs(1 To .Count, 1 To 1)
On Error Resume Next
For I = 1 To .Count
DoEvents
nom = .Item(I)
If I Mod 10 = 0 Then Application.StatusBar = nom
If InStr(1, UCase(extensions), UCase(Right(.Item(I), 4))) > 0 Then
a = a + 1
Classeurs(a, 1) = .Item(I)
End If
Next I
Application.ScreenUpdating = False
cel = feuille.Range("A65536").End(xlUp).Offset(1, 0).Address
With feuille.Range(cel).Resize(a)
.Value = Classeurs
.Sort [A1]
End With
End With
End With
Next disk
With feuille
.Range("A1:" & .Range("A65536").End(xlUp).Address).Select
Selection.Sort [A1]
For Each cel In Selection
cellule = cel.Address
contenu = cel.Value
Range(cellule).ClearContents
ActiveSheet.Hyperlinks.Add Anchor:=Range(cellule), Address:=contenu
Next cel
End With
Application.StatusBar = False
End Sub
Pour info, c'est tiré de ma réponse du 07/02 dans le premier fil que tu
sembles avoir délaissé.
@+
FxM
BlackStorm wrote:
Merci en tout cas pour ton aide !
Je t'explique comment je procéde, parce que je suis pas doué !
Je crée une macro que j'arrete immédiatement. Puis je selectionne cette
macro et je passe en mode modification. Et là j'insere les lignes de
codes
suivantes.
ET ca ne marche pas.
Je sais que je ne fais pas ce qu'il faut !! Si tu pouvais m'expliquer en
détails je te serai infiniment reconnaissant. Autre chose, les lecteurs
que
je veux scanner sont des lecteurs reseau F: et G:
Big merci d'avance.
Bonjour,
Pas optimisée pour deux sous, ni testée dans ses limitations mais ca
semble marcher. Je te laisse le soin d'adapter les chemins, extensions
(. suivi de 3 caractères), noms de feuille, ...
Sub RecupNomsFichiers()
Application.StatusBar = "Un moment, SVP ..."
Dim arr_disk, Classeurs() As String, i
Dim feuille, extensions, disk, nom, a,cel,cellule,contenu
Set feuille = Sheets("Feuil1")
arr_disk = Array("D: 0", "C:pdf")
extensions = ".xls.doc.eml.pdf.xlm"
For Each disk In arr_disk
If Right(disk, 1) <> "" Then disk = disk & ""
With Application.FileSearch
.NewSearch
.Filename = "*.*"
.LookIn = disk
.SearchSubFolders = True
.Execute
With .FoundFiles
ReDim Classeurs(1 To .Count, 1 To 1)
On Error Resume Next
For I = 1 To .Count
DoEvents
nom = .Item(I)
If I Mod 10 = 0 Then Application.StatusBar = nom
If InStr(1, UCase(extensions), UCase(Right(.Item(I), 4))) > 0 Then
a = a + 1
Classeurs(a, 1) = .Item(I)
End If
Next I
Application.ScreenUpdating = False
cel = feuille.Range("A65536").End(xlUp).Offset(1, 0).Address
With feuille.Range(cel).Resize(a)
.Value = Classeurs
.Sort [A1]
End With
End With
End With
Next disk
With feuille
.Range("A1:" & .Range("A65536").End(xlUp).Address).Select
Selection.Sort [A1]
For Each cel In Selection
cellule = cel.Address
contenu = cel.Value
Range(cellule).ClearContents
ActiveSheet.Hyperlinks.Add Anchor:=Range(cellule), Address:=contenu
Next cel
End With
Application.StatusBar = False
End Sub
Pour info, c'est tiré de ma réponse du 07/02 dans le premier fil que tu
sembles avoir délaissé.
@+
FxM
BlackStorm wrote:Merci en tout cas pour ton aide !
Je t'explique comment je procéde, parce que je suis pas doué !
Je crée une macro que j'arrete immédiatement. Puis je selectionne cette
macro et je passe en mode modification. Et là j'insere les lignes de
codes
suivantes.
ET ca ne marche pas.
Je sais que je ne fais pas ce qu'il faut !! Si tu pouvais m'expliquer en
détails je te serai infiniment reconnaissant. Autre chose, les lecteurs
que
je veux scanner sont des lecteurs reseau F: et G:
Big merci d'avance.