Le portail francophone de la géomatique

J'ai essayé les differents logiciels mais apparemment ça ne fait pas ce que je recherche à faire...Ca cree des catalogues et on peut faire des recherches dans ces catalogues (ex : rechercher les fichiers .shp) mais on ne peut pas exporter ces "recherches", on ne peut exporter que les catalogues..
Il faudrait que je puisse avoir la liste des fichiers shape en .txt, mais seulement les fichiers shape, l'ideal serait d'avoir un fichier Excel avec 1 cellule par .shp existant sur le PC, celà est il possible? (peut etre grâce à un petit programme sous Excel?)

Merci

Lorsque je rentre ça sous excel j'ai un message d'erreur d'affectation de "tt" à un tableau, je suis débutant en VBA donc je ne vois pas trop d'où ça peut venir. Si qqu'un voit d'où vient le problème..?

Merci

je l'avais changé j'avais vu la faute de frappe mais j'ai toujours le meme message d'erreur concernant l'affectation de "tt" à un tableau

"erreur de compilation

impossible d'affecter à un tableau"

Ca plante à la ligne :

tt = RechercheFichiers("G:\Geomatique\", "*.shp", True)
(j'ai bien entendu changé le répertoire chez moi)

mais c'est peut etre à cause de la version d'excel alors, c'est possible? c'est sur excel 97, et le vba editor qui va avec...pourtant j'ai régulièrement utilisé des macros pour excel et ça marchait.. Si chez toi ça marche c'est que ça devrait venir de ma version d'excel, aïe !!..

Bonjour,

Il faut que vous utilisiez l'invit de commande DOS (programme/accessoire)
Placez vous dans le répertorie de votre choix:
D:
cd repertoire
Puis tapez
attrib /s *.shp > fichier.txt

Cela va vous fabriquez un fichier texte listant tous les shapes du répertoire. Ca place le fichier dans le répertoire pour lequel vous avez demandé la recherche.

A+

Dernière modification par Miniopterine (Wed 08 August 2007 22:57)

Bonjour,

J'ai un bout de code VB qui fait appel à plusieurs API Win32 que voici :



Je peux vous envoyer le projet VB qui fait ça ou l'exe directement.
Actuellement les resultats sont inscrit dans une liste ce qui est difficile à récupérer, mais on doit pouvoir modifier le code pour écrire ça dans une zone de texte que l'on pourrait copier-coller dans Excel.

Option Explicit
'----------------------------------------
'------Déclarations propres aux API------
'----------------------------------------

'----------------------------------------
'------Déclarations propre au browser----
'----------------------------------------
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260 'Car déjà déclarée plus loin

Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As
BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal
pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal
lpString1 As String, ByVal lpString2 As String) As Long

Private Type BrowseInfo
   hWndOwner      As Long
   pIDLRoot       As Long
   pszDisplayName As Long
   lpszTitle      As Long
   ulFlags        As Long
   lpfnCallback   As Long
   lParam         As Long
   iImage         As Long
End Type


'---Les constantes---
'Private Const MAX_PATH = 260 'Car déjà déclarée plus loin
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800

'---Les API---
Private Declare Function FindFirstFile Lib "kernel32" Alias
"FindFirstFileA" _
         (ByVal lpFileName As String, lpFindFileData As
WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias
"FindNextFileA" _
         (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA)
As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As
Long) As Long

'---Les types---
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type

'----------------------------------------------
'------Déclarations propres à la fonction------
'----------------------------------------------
Private Type ListeFichier
    Fichiers() As WIN32_FIND_DATA
    Chemin() As String * MAX_PATH
    Nombre As Long
End Type


'--------------------------------------------------------
'---La fonction Rechercher : ---
'--- Cette fonction recherche tous les fichiers dans ---
'--- le répertoire spécifié et ses sous-repertoires ---
'--- Elle retourne le nombre d'occurences trouvées ---
'--------------------------------------------------------
Private Function Rechercher(Chemin As String, FichierR As String, _
        ResultatRecherche As ListeFichier) As Long
'---Déclaration des variables---
Dim lpFindFileData As WIN32_FIND_DATA
Dim hFindFile As Long
Dim lgRep As Long
Dim CheminRep As String
'---Recherche tous les fichiers demandés dans le répertoire Chemin---
hFindFile = FindFirstFile(Chemin & FichierR, lpFindFileData)
If hFindFile <> INVALID_HANDLE_VALUE Then
    Do
        ' Mémorise
        ResultatRecherche.Nombre = ResultatRecherche.Nombre + 1
        ReDim Preserve ResultatRecherche.Chemin(1 To
ResultatRecherche.Nombre)
        ReDim Preserve ResultatRecherche.Fichiers(1 To
ResultatRecherche.Nombre)
        ResultatRecherche.Chemin(ResultatRecherche.Nombre) = Chemin
        ResultatRecherche.Fichiers(ResultatRecherche.Nombre) =
lpFindFileData
        ' Initialise lpFindFileData (Variable texte uniquement)
        lpFindFileData.cAlternate = String$(14, 0)
        lpFindFileData.cFileName = String$(MAX_PATH, 0)
    Loop Until FindNextFile(hFindFile, lpFindFileData) = 0
End If
FindClose hFindFile
'---Recherche dans les sous-répertoires---
hFindFile = FindFirstFile(Chemin & "*.*", lpFindFileData)
If (hFindFile <> INVALID_HANDLE_VALUE) Then
    Do
        ' Si c'est un répertoire on continu le recherche
        If (lpFindFileData.dwFileAttributes And _
            FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
            ' Extraction du nom du répertoire
            CheminRep = Mid$(lpFindFileData.cFileName, 1, _
                        InStr(1, lpFindFileData.cFileName, Chr$(0)) - 1)
            ' Attention dans les sous-répertoire aux
            ' répertoires . et .. (Retour répertoire parent)
            If (CheminRep <> ".") And (CheminRep <> "..")
Then
                CheminRep = Chemin & CheminRep & ""
                Rechercher = Rechercher(CheminRep, FichierR,
ResultatRecherche)
            End If
        End If
    Loop Until FindNextFile(hFindFile, lpFindFileData) = 0
End If
FindClose hFindFile
'---Retourne le nombre d'occurrences trouvées---
Rechercher = ResultatRecherche.Nombre

On Error GoTo Err_Search_Handler

Exit Function
Err_Search_Handler:
MsgBox "Lecteur invalide"

End Function



Private Sub Command1_Click()
' Algorithme récursif
'---Déclaration des variables---
Dim ResultatRecherche As ListeFichier
Dim NombreOccurence As Long
Dim i

If ((Not Text1.Text = "") And (Not Text2.Text = "")) Then

Label6.Caption = ""
List1.Clear
Me.MousePointer = vbHourglass

'---Recherche de tous les fichiers *.frm sur le lecteur D:---
NombreOccurence = Rechercher(Text2.Text, Text1.Text, ResultatRecherche)
' Toutes les informations de la recherche sont dans la variables
ResultatRecherche

Label6.Caption = Str(NombreOccurence) + " fichier(s) trouvé(s)."

'Remplissage de la ListBox
Dim montexte As String
For i = 1 To ResultatRecherche.Nombre
    montexte = Trim(ResultatRecherche.Chemin(i)) &
Trim(ResultatRecherche.Fichiers(i).cFileName)
    List1.AddItem (montexte)
Next i

Me.MousePointer = vbDefault

'MsgBox NombreOccurence & " ont été trouvées (ou a été trouvé)"
& Chr(13) & _
'       "Le premier fichier trouvé est : " &
Trim$(ResultatRecherche.Chemin(1)) & _
'       Trim$(ResultatRecherche.Fichiers(1).cFileName)

Else

MsgBox "Saisir le nom du fichier et la lettre du lecteur.",
vbInformation, "Attention"

End If

End Sub

Private Sub HScroll1_Change()

End Sub




Private Sub Command2_Click()
'Opens a Treeview control that displays the directories in a computer

   Dim lpIDList As Long
   Dim sBuffer As String
   Dim szTitle As String
   Dim tBrowseInfo As BrowseInfo

   szTitle = "This is the title"
   With tBrowseInfo
      .hWndOwner = Me.hWnd
      .lpszTitle = lstrcat(szTitle, "")
      .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
   End With

   lpIDList = SHBrowseForFolder(tBrowseInfo)

   If (lpIDList) Then
      sBuffer = Space(MAX_PATH)
      SHGetPathFromIDList lpIDList, sBuffer
      sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
     
      If (Len(sBuffer) = 3) Then
        Text2 = sBuffer
      Else
        Text2 = sBuffer + ""
      End If
     
      Me.Text2.SetFocus
    End If
End Sub


Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then Command2_Click
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then Command1_Click
End Sub