אופיס 365 חיפוש קובץ באקסס

[אריה123]

יש פקודה FILESEARCH לחפש קבצים.

הפקודה הזו עובדת מצוין באופיס 2003, אבל ב 2010 משום מה הם השמיטו את זה, מה הפקודה הנכונה ב 2010 ?

 

[yits]

זה הפונקציה שמצאתי

Function FindFiles(path As String, SearchStr As String, _
       FileCount As Integer, DirCount As Integer)
      Dim FileName As String   ' Walking filename variable.
      Dim DirName As String    ' SubDirectory Name.
      Dim dirNames() As String ' Buffer for directory name entries.
      Dim nDir As Integer      ' Number of directories in this path.
      Dim i As Integer         ' For-loop counter.

      On Error GoTo sysFileERR
      If Right(path, 1) <> "\" Then path = path & "\"
      ' Search for subdirectories.
      nDir = 0
      ReDim dirNames(nDir)
      DirName = Dir(path, vbDirectory Or vbHidden Or vbArchive Or vbReadOnly _
Or vbSystem)  ' Even if hidden, and so on.
      Do While Len(DirName) > 0
         ' Ignore the current and encompassing directories.
         If (DirName <> ".") And (DirName <> "..") Then
            ' Check for directory with bitwise comparison.
            If GetAttr(path & DirName) And vbDirectory Then
               dirNames(nDir) = DirName
               DirCount = DirCount + 1
               nDir = nDir + 1
               ReDim Preserve dirNames(nDir)
               'List2.AddItem path & DirName ' Uncomment to list
            End If                           ' directories.
sysFileERRCont:
         End If
         DirName = Dir()  ' Get next subdirectory.
      Loop

      ' Search through this directory and sum file sizes.
      FileName = Dir(path & SearchStr, vbNormal Or vbHidden Or vbSystem _
      Or vbReadOnly Or vbArchive)
      While Len(FileName) <> 0
         FindFiles = FindFiles + FileLen(path & FileName)
         FileCount = FileCount + 1
         ' Load List box
         list2.AddItem path & FileName & vbTab & _
            FileDateTime(path & FileName)   ' Include Modified Date
         FileName = Dir()  ' Get next file.
      Wend

      ' If there are sub-directories..
      If nDir > 0 Then
         ' Recursively walk into them
         For i = 0 To nDir - 1
           FindFiles = FindFiles + FindFiles(path & dirNames(i) & "\", _
            SearchStr, FileCount, DirCount)
         Next i
      End If

AbortFunction:
      Exit Function
sysFileERR:
      If Right(DirName, 4) = ".sys" Then
        Resume sysFileERRCont ' Known issue with pagefile.sys
      Else
        MsgBox "Error: " & Err.Number & " - " & Err.Description, , _
         "Unexpected Error"
        Resume AbortFunction
      End If
      End Function

הפונקציה בנויה לטופס עם שני כפתורים (אבל מספיק אחד)
ויש בה 4 תיבות טקסט
ותיבת רשימה אחת עם ערכים מרובים

הפקודה שעושה הכפתור החיפוש הוא

Private Sub Command2_Click()
      Dim SearchPath As String, FindStr As String
      Dim FileSize As Long
      Dim NumFiles As Integer, NumDirs As Integer
      Screen.MousePointer = vbHourglass
     list2.Value = ""
      SearchPath = Text1.Value
      FindStr = text2.Value
      FileSize = FindFiles(SearchPath, FindStr, NumFiles, NumDirs)
      Text5.Value = NumFiles & " Files found in " & NumDirs + 1 & _
       " Directories"
      Text6.Value = "Size of files found under " & SearchPath & " = " & _
      Format(FileSize, "#,###,###,##0") & " Bytes"
      Screen.MousePointer = vbDefault
      End Sub

ובפתיחת הטופס הוא מגדיר את הפקדים האלו:

Private Sub Form_Load()
      Command1.Caption = "Use API code"
      Command2.Caption = "Use VB code"
      ' start with some reasonable defaults
      Text1.Value = "C:\My Documents\"
      text2.Value = "*.*"
   End Sub

בהצלחה

 

[moishy]

יש שלש אפשרויות לפי הידוע לי.
1. Dir
2. FileSystemObject
3. השיטה המועדפת עלי: קוד מחלקה. מצורפת דוגמא (באנגלית כמובן...). הנה קישור המסביר את הקוד ואופן השימוש בו: http://dfenton.com/DFA/download/Access/FileSearch.html

 

[moishy]

במחשבה שניה יש עוד כמה אפשרויות כמו API ועוד, ומ"מ די במה שכבר צוין.