Tjek af filnavne

hey

nu sad jeg lige og kedede mig lidt og snittede lidt i diverse løsninger fra Eksperten her og lidt egen gammel kodning... Så prøv at smid dette på en form og se om det ikke løser nogen af dine problemer. Det er VB6 den er lavet i og du overskriver bare alt i formens kodning - der er ingen controls tilføjet altså textbokse eller lign. Dog skal Microsoft Scripting Runtime være tilføjet som reference...

Mvh HIKS og go weekend

'FORM START HER

Dim arrayplace As Variant

Private Sub Form_Load()
arrayplace = HentFil(App.Path & "\fil.txt") 'din inputfil m. placeringer

Dim i As Byte
Dim filesFound As Long
Dim strTemp As String
Dim BADLIST As String

BADLIST = "?..?*;?~?*,?Æ?*;?Ø?*;?Å?*;?æ?*;?ø?*;?å?*;?´?*;?`?*;?|?*;?^?*;?" & Chr(34) & "?*;?,?*"

filesFound = 0

For i = 0 To UBound(arrayplace)
    filesFound = filesFound + GetAllFiles(arrayplace(i), BADLIST, True).Count
Next i

MsgBox "Antal filer fundet: " & filesFound

End Sub

Private Function SkrivFil(filnavn As String, output As String)

  Open filnavn For Append As #1
      Print #1, output
  Close #1

End Function

Private Function HentFil(filnavn As String) 'kaldes inkl. path

    Dim Filnummer As Integer
    Dim MinString()
    Dim intcount As Integer
   
    Filnummer = FreeFile
    intcount = 0
    Open filnavn For Input As #Filnummer
        Do While Not EOF(Filnummer)
            ReDim Preserve MinString(intcount)
            Line Input #Filnummer, MinString(intcount)
            intcount = intcount + 1
        Loop
    Close #Filnummer
   
    HentFil = MinString
   
End Function

Function GetAllFiles(ByVal Path As String, ByVal filespec As String, Optional RecurseDirs As Boolean) As Collection
    Dim spec As Variant
    Dim file As Variant
    Dim subdir As Variant
    Dim subdirs As New Collection
    Dim specs() As String
   
    ' initialize the result
    Set GetAllFiles = New Collection
   
    ' ensure that path has a trailing backslash
    If Right$(Path, 1) <> "\" Then Path = Path & "\"
   
    ' get the list of provided file specifications
    specs() = Split(filespec, ";")
   
    ' this is necessary to ignore duplicates in result
    ' caused by overlapping file specifications
    On Error Resume Next
               
    ' at each iteration search for a different filespec
    For Each spec In specs
        ' start the search
        file = Dir$(Path & spec)
        Do While Len(file)
            ' we've found a new file
            If HeleStien = True Then
                file = Path & file
            Else
                file = file
            End If
            GetAllFiles.Add file, file
         
            Call SkrivFil(App.Path & "\" & Format(Now(), "yy_mm_dd_hh") & "_out.txt", Path & GetAllFiles.Item(file))
           
            ' get ready for the next iteration
            file = Dir$
        Loop
    Next
   
    ' first, build the list of subdirectories to be searched
    If RecurseDirs Then
        ' get the collection of subdirectories
        ' start the search
        file = Dir$(Path & "*.*", vbDirectory)
        Do While Len(file)
            ' we've found a new directory
            If file = "." Or file = ".." Then
                ' exclude the "." and ".." entries
            ElseIf (GetAttr(Path & file) And vbDirectory) = 0 Then
                ' ignore regular files
            Else
                ' this is a directory, include the path in the collection
                file = Path & file
                subdirs.Add file, file
            End If
            ' get next directory
            file = Dir$
        Loop
        ' parse each subdirectory
        For Each subdir In subdirs
            ' use GetAllFiles recursively
            For Each file In GetAllFiles(subdir, filespec, True)
                GetAllFiles.Add file, file
            Next
        Next
    End If
   
End Function

glemte helt at skrive at du skal have en fil der hedder: fil.txt hvor du skal angive biblioteker/directories bare adskilt med linieskift... Den skal ligge i samme dir. som formen bliver udført fra.

Programmet spytter en fil ud der hedder: yy_mm_dd_hh_out.txt altså bestående af årstal-måned-dato-time

mvh Hiks

Alternativt kan du bruge Keypress til at fange tastetryk der hvor brugeren skriver filnavne, og annulerer ?%<> osv.
(Set keyascii=0)

ja men så skal han jo have en process til at køre lokalt hos alle hans brugere. Men det er nu også en god idé at lave noget præventivt også - alternativt tror jeg vil gøre det gennem styresystemet og sætte nogle restriktioner der. Men det er sæføli afhængigt af hvilket styresystem, der er tilgængeligt.

/hiks

hiks: Nå ja, havde ikke helt fattet hvad han mente.

Men kan det ikke gøres meget kortere - lave en lille sub der undersøger et filnavn for <>? osv forinden kopiering - det fylder ikke meget mere end et par linier. Indrømmet, har ikke læst din kode, men den ser så laaaaang ud ;o)

jow den ser en smule lang ud - men har også bare klippet det sammen vha den glimrende søgefunktion her på Eksperten.dk :o) - og havde engang brugt den før så pointen med det jeg skrev var egentlig bare at spørgsmålet kunne være klaret med en søgning... har ikke kigget på kvalitet af koden andet end at den virker og at det går ok hurtigt...

men lad os se hvad der bliver svaret... og indrømmet ja - det kan da laves kortere men er det nu også nødvendigt... :o)

/hiks

lukketid?