|
| Fil liste Fra : Jens Andersen |
Dato : 10-01-01 22:37 |
|
Jeg har lavet et program som laver en txt fil over alle ens mp3 filer
Det køre som det skal bare ikke hvis man har mange så for man en Overflow
kan i se hvad man kan gøre for at undgå denne fejl
Option Explicit
Dim fso As New FileSystemObject
Dim fld As Folder
Dim tel As Long
Dim sti As String
Private Sub Command1_Click()
Dim nDirs As Long, nFiles As Long, lSize As Long
Dim sDir As String, sSrchString As String
sDir = "C:\"
sSrchString = "*.mp3"
tel = 0
sti = "C:\windows\skrivebord\mp3 på C.txt"
MousePointer = vbHourglass
Label1.Caption = "Searching " & vbCrLf & UCase(sDir) & "..."
lSize = FindFile(sDir, sSrchString, nDirs, nFiles)
MousePointer = vbDefault
Open sti For Append As #1
Print #1, ""
Print #1, "Antal " & tel
Close #1
MsgBox "Færdig !"
End Sub
Private Function FindFile(ByVal sFol As String, sFile As String, _
nDirs As Long, nFiles As Long) As Long
Dim tFld As Folder, tFil As File, FileName As String
Set fld = fso.GetFolder(sFol)
FileName = Dir(fso.BuildPath(fld.Path, sFile), vbNormal Or _
vbHidden Or vbSystem Or vbReadOnly)
While Len(FileName) <> 0
FindFile = FindFile + FileLen(fso.BuildPath(fld.Path, FileName))
nFiles = nFiles + 1
tel = tel + 1
Open sti For Append As #1
Print #1, FileName
Close #1
FileName = Dir() ' Get next file
DoEvents
Wend
Label1 = "Searching " & vbCrLf & fld.Path & "..."
nDirs = nDirs + 1
If fld.SubFolders.Count > 0 Then
For Each tFld In fld.SubFolders
DoEvents
FindFile = FindFile + FindFile(tFld.Path, sFile, nDirs, nFiles)
Next
End If
End Function
| |
Helge Bjørkhaug (11-01-2001)
| Kommentar Fra : Helge Bjørkhaug |
Dato : 11-01-01 00:47 |
|
"Jens Andersen" <til@infojens.dk> wrote in message news:93ikm8$kc7$1@news.inet.tele.dk...
> Jeg har lavet et program som laver en txt fil over alle ens mp3 filer
>
> Det køre som det skal bare ikke hvis man har mange så for man en Overflow
> kan i se hvad man kan gøre for at undgå denne fejl
>
> Option Explicit
> Dim fso As New FileSystemObject
> Dim fld As Folder
> Dim tel As Long
> Dim sti As String
>
> Private Sub Command1_Click()
> Dim nDirs As Long, nFiles As Long, lSize As Long
> Dim sDir As String, sSrchString As String
> sDir = "C:\"
> sSrchString = "*.mp3"
> tel = 0
> sti = "C:\windows\skrivebord\mp3 på C.txt"
> MousePointer = vbHourglass
> Label1.Caption = "Searching " & vbCrLf & UCase(sDir) & "..."
> lSize = FindFile(sDir, sSrchString, nDirs, nFiles)
> MousePointer = vbDefault
> Open sti For Append As #1
> Print #1, ""
> Print #1, "Antal " & tel
> Close #1
> MsgBox "Færdig !"
> End Sub
>
> Private Function FindFile(ByVal sFol As String, sFile As String, _
> nDirs As Long, nFiles As Long) As Long
> Dim tFld As Folder, tFil As File, FileName As String
>
> Set fld = fso.GetFolder(sFol)
> FileName = Dir(fso.BuildPath(fld.Path, sFile), vbNormal Or _
> vbHidden Or vbSystem Or vbReadOnly)
> While Len(FileName) <> 0
> FindFile = FindFile + FileLen(fso.BuildPath(fld.Path, FileName))
> nFiles = nFiles + 1
> tel = tel + 1
> Open sti For Append As #1
> Print #1, FileName
> Close #1
> FileName = Dir() ' Get next file
> DoEvents
> Wend
> Label1 = "Searching " & vbCrLf & fld.Path & "..."
> nDirs = nDirs + 1
> If fld.SubFolders.Count > 0 Then
> For Each tFld In fld.SubFolders
> DoEvents
> FindFile = FindFile + FindFile(tFld.Path, sFile, nDirs, nFiles)
> Next
> End If
> End Function
>
Stopper den på denne linjen?
tel = tel + 1
Mvh,
Helge
| |
Jens Andersen (11-01-2001)
| Kommentar Fra : Jens Andersen |
Dato : 11-01-01 01:07 |
|
Til Helge
Den stopper ved
FindFile = FindFile + FindFile(tFld.Path, sFile, nDirs, nFiles)
| |
Helge Bjørkhaug (11-01-2001)
| Kommentar Fra : Helge Bjørkhaug |
Dato : 11-01-01 11:37 |
|
"Jens Andersen" <til@infojens.dk> skrev i melding news:93itfa$991$1@news.inet.tele.dk...
> Til Helge
>
> Den stopper ved
>
> FindFile = FindFile + FindFile(tFld.Path, sFile, nDirs, nFiles)
-------- --------
denne linje gjør jo at funksjonen kaller opp seg selv, er vel ikke så bra!!!.....
FindFile er også dim'et som long, kan jo endres til double.
Mvh,
Helge
| |
Jens Andersen (11-01-2001)
| Kommentar Fra : Jens Andersen |
Dato : 11-01-01 17:20 |
|
Det virker !!!!
Tusinde tak .....
Hilsen
Jens
| |
|
|