Dir på biblioteker og filer

hvordan gør du nu ?

Prøv at se her:
http://www.eksperten.dk/spm/94732

Hej jelzin101 

for at udlæse biblioter i et niveau, bruger jeg denne kode.

Private Sub Command5_Click()
Dim myfile, mypath, MyName, filen

mypath = \"c:\\temp\\\"
MyName = Dir(mypath, vbDirectory)
Do While MyName <> \"\"
 
  If MyName <> \".\" And MyName <> \"..\" Then
        If (GetAttr(mypath & MyName) And vbDirectory) = vbDirectory Then
        Debug.Print MyName
        MsgBox \"Bib er : \" & MyName
       
      End If
  End If
  MyName = Dir
Loop
End Sub

er det sådan du mener:

Sub RefreshLocal()
On Error Resume Next
Dim NextLocal As String
Dim FullSpec As String

List1.Clear
List2.Clear

If Len(CurDir()) = 3 Then
    FullSpec = CurDir() & \"*.*\"
        Else
    FullSpec = CurDir() & \"\\*.*\"
End If

NextLocal = Dir(FullSpec, vbDirectory + vbNormal)

Do While NextLocal <> \"\"
    If Len(CurDir()) = 3 Then
        FullSpec = CurDir() & StrConv(NextLocal, vbProperCase)
            Else
        FullSpec = CurDir() & \"\\\" & NextLocal
    End If
    If (GetAttr(FullSpec) And vbDirectory) = vbDirectory Then
        List1.AddItem StrConv(NextLocal, vbProperCase) \'Directory
            Else
        List2.AddItem StrConv(NextLocal, vbProperCase) \'Files
    End If
NextLocal = Dir
Loop
End Sub

Private Sub List1_DblClick()
If List1.Text = \".\" Then ChDir \"\\\"
ChDir List1.Text
RefreshLocal
End Sub

Private Sub Form_Load()
ChDrive \"C:\\\"
ChDir \"C:\\temp\"
RefreshLocal
End Sub

God kode helt sikkert

Men kan man så lave en function som indskriver alle filer ind i en listbox div. alle fil i C:\\temp + alle de filer som ligge i undermapperne på C:\\temp

Kode som jeg har søgt længe...

Hej SJH
Det er næsten som jeg gerne vil have det, men jeg har også brug for at programmet ser underbiblioteker og tilhørende filer. Jeg skal bruge programmet til at kontrollere om der er ankommet en fil til et vilkårligt bibliotek eller underbibliotek, under c:\\temp, der efterfølgende skal udløse et andet program. Det sidste del af programmet har jeg lavet.

mvh

Henrik

Indsæt følgende controller på en form:
DriveListBox
DirListBox
FileListBox

Skriv disse to rutiner:

Private Sub Dir1_Change()
    File1.Path = Dir1.Path
End Sub

Private Sub Drive1_Change()
    Dir1.Path = Drive1.Drive
End Sub

Hej Johs_J

Tak for det, men egentlig skal jeg slet ikke bruge liste og bokse, men programmet skulle gerne udføre et program, når der bliver lavet en fil i et underbibliotek. Problemet er at man ikke på forhånd kender navnet og antal biblioteker og ej heller filernes navn, kun extension.

Her kan du se alle filer i alle mapperne (Path + File)

\'------------------------------------ Module1 ------------------------------------
Option Explicit

Declare Function FindFirstFile Lib \"kernel32\" Alias _
\"FindFirstFileA\" (ByVal lpFileName As String, lpFindFileData _
As WIN32_FIND_DATA) As Long

Declare Function FindNextFile Lib \"kernel32\" Alias _
\"FindNextFileA\" (ByVal hFindFile As Long, _
lpFindFileData As WIN32_FIND_DATA) As Long

Declare Function GetFileAttributes Lib \"kernel32\" Alias _
\"GetFileAttributesA\" (ByVal lpFileName As String) As Long

Declare Function FindClose Lib \"kernel32\" (ByVal hFindFile _
As Long) As Long

Public Const MAX_PATH = 260
Public Const MAXDWORD = &HFFFF
Public Const INVALID_HANDLE_VALUE = -1
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100

Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

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

Public Function StripNulls(OriginalStr As String) As String
If (InStr(OriginalStr, Chr(0)) > 0) Then
    OriginalStr = Left(OriginalStr, _
    InStr(OriginalStr, Chr(0)) - 1)
End If
StripNulls = OriginalStr
End Function

Function FindFilesAPI(Path As String, SearchStr As String, _
FileCount As Integer, DirCount As Integer, ListBox As ListBox)
Dim Cont As Integer
Dim FileName As String
Dim DirName As String
Dim dirNames() As String
Dim nDir As Integer
Dim i As Integer
Dim hSearch As Long
Dim WFD As WIN32_FIND_DATA
Dim ListItem As ListItem

If Right(Path, 1) <> \"\\\" Then Path = Path & \"\\\"
nDir = 0
ReDim dirNames(nDir)
Cont = True
hSearch = FindFirstFile(Path & \"*\", WFD)
If hSearch <> INVALID_HANDLE_VALUE Then
    Do While Cont
    DirName = StripNulls(WFD.cFileName)
    If (DirName <> \".\") And (DirName <> \"..\") Then
        If GetFileAttributes(Path & DirName) And _
        FILE_ATTRIBUTE_DIRECTORY Then
            dirNames(nDir) = DirName
            DirCount = DirCount + 1
            nDir = nDir + 1
            ReDim Preserve dirNames(nDir)
        End If
    End If
    Cont = FindNextFile(hSearch, WFD)
    \'DoEvents
    Loop
    Cont = FindClose(hSearch)
End If
hSearch = FindFirstFile(Path & SearchStr, WFD)
Cont = True
If hSearch <> INVALID_HANDLE_VALUE Then
    While Cont
    FileName = StripNulls(WFD.cFileName)
    If (FileName <> \".\") And (FileName <> \"..\") Then
        FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * _
        MAXDWORD) + WFD.nFileSizeLow
        FileCount = FileCount + 1
        \'------------ Add Path & FileName -------------
        ListBox.AddItem Path & StrConv(FileName, vbProperCase) \'List1
        \'------------ Add Path & FileName -------------
    End If
    Cont = FindNextFile(hSearch, WFD)
    Wend
    Cont = FindClose(hSearch)
End If
If nDir > 0 Then
    For i = 0 To nDir - 1
    FindFilesAPI = FindFilesAPI + FindFilesAPI(Path & _
    dirNames(i) & \"\\\", SearchStr, FileCount, DirCount, ListBox)
    Next i
End If
End Function
\'------------------------------------ Module1 ------------------------------------


\'------------------------------------- Form1 -------------------------------------
Option Explicit

Private Sub Command1_Click()
Dim SearchPath As String, FindStr As String
Dim FileSize As Long
Dim NumFiles As Integer, NumDirs As Integer
Command1.Enabled = False
List1.Clear \'List1
SearchPath = Text1.Text \'Path
FindStr = Text2.Text \'Find file navn
FileSize = FindFilesAPI(SearchPath, FindStr, NumFiles, NumDirs, List1)
If NumDirs < 1 Then
  Text3.Text = NumFiles & \" Filer fundet i \" & NumDirs + 1 & \" Mappe\" \'Status
    Else
  Text3.Text = NumFiles & \" Filer fundet i \" & NumDirs + 1 & \" Mapper\" \'Status
End If
Text4.Text = \"Total størrelse: \" & Format(FileSize, \"#,###,###,##0\") & \" Bytes\" \'Status
Command1.Enabled = True
End Sub

Private Sub Form_Load()
Text1.Text = App.Path \'Path
Text2.Text = \"*\" \'Find file navn
Text3.Text = \"\" \'Status
Text4.Text = \"\" \'Status
End Sub
\'------------------------------------- Form1 -------------------------------------

Hej SJH.

Det er meget tæt på hvad jeg skal bruge - tak for det. Hvis man laver f.eks. 3 underbib til et bibliotek, tæller programmet således at resultater er 3 filer i 4 mapper. Jeg har ikke helt gennemskuet programmet, men jeg håber at jeg kan tilrette det. MVH

Henrik