— للبحث عن ملف :
Set fs = Application.FileSearch
With fs
.LookIn = "C:My Documents"
.FileName = "DO.*"
If .Execute > 0 Then
MsgBox "There were " & .FoundFiles.Count & _
" file(s) found."
For I = 1 To .FoundFiles.Count
MsgBox .FoundFiles(I)
Next I
Else
MsgBox "There were no files found."
End If
End With
ولإعادة البحث :
With Application.FileSearch
If .Execute() > 0 Then
MsgBox "There were " & .FoundFiles.Count & _
" file(s) found."
For i = 1 To .FoundFiles.Count
MsgBox .FoundFiles(i)
Next i
Else
MsgBox "There were no files found."
End If
End With
ولإعادة البحث مع تحديد معيار أكثر تفصيلاً :
With Application.FileSearch
.NewSearch
.LookIn = "C:My Documents"
.SearchSubFolders = True
.FileName = "Run"
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
End With
انظر التفصيلات في هذا المثال :
With Application.FileSearch
.NewSearch
.LookIn = "C:My Documents"
.SearchSubFolders = True
.FileName = "run"
.TextOrProperty = "San*"
.MatchAllWordForms = True
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
MsgBox "There were " & .FoundFiles.Count & _
" file(s) found."
For I = 1 To .FoundFiles.Count
MsgBox .FoundFiles(i)
Next I
Else
MsgBox "There were no files found."
End If
End With
— لنسخ ملف إلى دليل آخر باستخدام الطريقة CopyFile
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFile "C:My Documentsشهادة.Gif",
"c:My DocumentsMy Pictures", True
True للكتابة فوق نسخة موجودة وFalse للنسخ بدون كتابة ، ويعطي رسالة خطأ إذا وجد نسخة .
— لنسخ ملف باستخدام FileCopy
Dim SourceFile, DestinationFile
SourceFile = "اسم الملف مع القرص والدليل"
DestinationFile = "اسم المحرك والمجلد"
FileCopy SourceFile, DestinationFile
— نسخ محتويات مجلد Folder إلى مجلد آخر باستخدام الطريقة CopyFolder
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFolder "C:My Documentsمجلد جديد"
"c:My Documentsبرامج", True
— لإنشاء مجلد جديد باستخدام الطريقة CreateFolder
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CreateFolder "C:My Documentsمجلد جديد"
● لإنشاء مجلد folder استخدم :
MkDir "اسم المجلد الجديد"
لاحظ إذا لم يكتب اسم محرك الأقراص قبل المجلد فسوف ينشأ المجلد على محرك الأقراص الحالي .
— لحذف ملف باستخدام الطريقة DeleteFile
Set fs = CreateObject("Scripting.FileSystemObject")
fs.DeleteFile "C:My Documentsنسخ من شهادة.gif", True
True لحذف ملف للقراء فقط وFalse لعدم حذفه .
— لحذف مجلد باستخدام الطريقة DeleteFolder
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
fs.DeleteFolder "C:My Documentsمجلد جديد", True
True لحذف مجلد للقراء فقط وFalse لعدم حذفه ، لاحظ أنه يحذف المجلد وكل الملفات التي بداخله .
— لحذف مجلد :
Rmdir "اسم المجلد"
لابد أن يكون هذا المجلد خالي من الملفات ليتم حذفه وإلا استخدم Kill لحذف الملفات أولا :
Kill ("اسم القرص والدليل والملف مع اللاحقة")
ولحدف كافة محتويات المجلد استخدم بعد القرص ثم المجلد :
*.*
ولحذف نوع ملفات استخدم النجمة واللاحقة مثال :
*.TXT
— لمعرفة أقراص المحركات الموجودة باستخدام الطريقة DriveExists
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
fs.DriveExists("c")
يعيد السطر الأخير True إذا وجد المحرك وFalse إذا لم يجده ، لاحظ أن المحركات القابلة للإزالة يعيد السطر الأخير لها True ولو لم تكن موجودة .
— لمعرفة الملفات الموجودة باستخدام الطريقة FileExists
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
MsgBox fs.FileExists("c:my documentsشهادة.gif")
يعيد السطر الأخير True إذا وجد الملف وFalse إذا لم يجده ، لاحظ أنه يجي عليك كتابة المجلد واسم الملف واللاحقة .
— لمعرفة المجلدات الموجودة باستخدام الطريقة FolderExists
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
MsgBox fs.FolderExists ("c:my documents")
يعيد السطر الأخير True إذا وجد المجلد وFalse إذا لم يجده ، لاحظ أنه يجي عليك كتابة المحرك واسم المجلد .
لمعرفة محركات الأقراص الموجودة في الحاسب :
Sub ShowDriveList
Dim fs, d, dc, s, n
Set fs = CreateObject("Scripting.FileSystemObject")
Set dc = fs.Drives
For Each d in dc
s = s & d.DriveLetter & " - "
If d.DriveType = 3 Then
n = d.ShareName
Else
n = d.VolumeName ' هذا السطر يظهر اسم محرك الأقراص قد يسبب مشاكل ويفضل تعطيله
End If
s = s & n & vbCrLf
Next
MsgBox s
End Sub
● لإظهار المحركات في قائمة منسدلة ؛ ضع في حدث عند التركيز :
Dim fs, d, dc
Dim الكل As Variant
Dim محركات_الأقراص As String
Set fs = CreateObject("Scripting.FileSystemObject")
Set dc = fs.Drives
For Each d In dc
محركات_الأقراص = d
If IsEmpty(الكل) Then
الكل = محركات_الأقراص & ""
Else
الكل = الكل & ";" & محركات_الأقراص & ""
End If
Next
Me![اسم القائمة المنسدلة].RowSource = الكل
ملاحظة هامة جداً : يجب جعل نوع مصدر الصف للقائمة هي قائمة القيم .
— لإظهار الملفات في دليل
Sub ShowFileList(folderspec)
Dim fs, f, f1, fc, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.Files
For Each f1 in fc
s = s & f1.name
s = s & vbCrLf
Next
MsgBox s
End Sub
ويستدعى من إجراء مع وسيطة اسم المجلد أو القرص ، مثال :
Call ShowFileList("C:My Documents")
- لمعرفة حجم ونوع ملف
Dim fs, f, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile("c:My Documentsdb1.mdb")
s = " اسم الملف هو :" & UCase(f.Name) & " وحجمه : " & "(" & (f.Size) & ")" & " ونوعه : " & f.Type
MsgBox s, vbMsgBoxRight + vbMsgBoxRtlReading, "معلومات ملف"
- لإظهار قائمة بأسماء ملفات الخطوط وليس أسماء الخطوط
Dim fs, f, f1, fc, s
Dim الملفات As String
Dim الكل As Variant
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder("C:WINDOWSFONTS")
Set fc = f.Files
For Each f1 In fc
If f1.Type = "ملف خط تروتايب" Then
الملفات = f1.Name
If IsEmpty(الكل) Then
الكل = الملفات
Else
الكل = الكل & ";" & الملفات
End If
End If
Next
List1.RowSource = UCase(الكل)
- لمعرفة حجم ونوع مجلد
Dim fs, f, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder("c:My Documents")
s = " اسم المجلد هو :" & UCase(f.Name) & " وحجمه : " & "(" & (f.Size) & ")" & " ونوعه : " & f.Type
MsgBox s, vbMsgBoxRight + vbMsgBoxRtlReading, "معلومات مجلد"
- لإعادة اسم ملف من دليل :
Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject")
MsgBox fs.GetFileName("c:My Documentsdb1.mdb")
يعيد السطر الأخير اسم الملف الموجود بعد اسم المجلد .
ولإعادة المجلد كاملاً استخدم :
MsgBox fs.GetFile("c:My Documentsdb1.mdb")
- لإعادة المجلد بعد المحرك من دليل :
Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject")
MsgBox fs.GetParentFolderName("c:KPCMSMy Documents")
- لنقل ملف استخدم الطريقة MoveFile
Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject")
fs.MoveFile "c:My Documentsسوند فورج.htm", "c:My DocumentsMy Htmal"
- نقل مجلد باستخدام MoveFolder
Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject")
fs.MoveFolder "c:المجلد المطلوب نقله", "c:المجلد الذي سينقل إليه المجد السابق"
- لإظهار قائمة بالمجلدات قم باستدعاء التالي:
Sub ShowFolderList(folderspec)
Dim fs, f, f1, s, sf
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set sf = f.SubFolders
For Each f1 In sf
s = s & f1.Name
s = s & vbCrLf
Next
MsgBox s
End Sub
ولجعلها تظهر في قائمة منسدلة :
Dim fs, f, f1, s, sf
Dim الكل As Variant
Dim كل_المجلدات As String
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder([قرص])
Set sf = f.SubFolders
For Each f1 In sf
كل_المجلدات = f1.Name
If IsEmpty(الكل) Then
الكل = كل_المجلدات
Else
الكل = الكل & ";" & كل_المجلدات
End If
Next
Me![اسم القائمة المنسدلة].RowSource = الكل
مع وضع وسيطه إما محرك أقراص أو مجلد ، مثال :
Call ShowFolderList("c:")
— لإظهار كافة المجلدات في قرص أو دليل وطباعتها في الدبج :
MyPath = "c:"
MyName = Dir(MyPath, vbDirectory)
Do While MyName <> ""
If MyName <> "." And MyName <> ".." Then
If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
Debug.Print MyName
End If
End If
MyName = Dir
Loop
ولإظهارها في قائمة منسدلة :
Dim الكل As Variant
Dim كل_المجلدات As String
MyPath = قرص
كل_المجلدات = Dir([MyPath], vbDirectory)
Do While كل_المجلدات <> ""
If كل_المجلدات <> "." And كل_المجلدات <> ".." Then
If (GetAttr(MyPath & كل_المجلدات) And vbDirectory) = vbDirectory Then
If IsEmpty(الكل) Then
الكل = كل_المجلدات
Else
الكل = الكل & ";" & كل_المجلدات
End If
End If
End If
كل_المجلدات = Dir
Loop
Me![اسم القائمة المنسدلة].RowSource = الكل
— لإظهار أول ملف بخاصية معينة
Dim MyFile
MyFile = Dir("*.TXT", vbHidden)
- لإظهار معلومات عن ملف استدعي الإجراء التالي :
Sub ShowFileAccessInfo(filespec)
Dim fs, f, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(filespec)
s = UCase(filespec) & vbCrLf
s = s & "تاريخ الإنشاء: " & f.DateCreated & vbCrLf
s = s & "التشغيل الأخير: " & f.DateLastAccessed & vbCrLf
s = s & "التعديل الأخير: " & f.DateLastModified
MsgBox s, 0, "معلومات ملف"
End Sub
مع وضع وسيطه إما محرك أقراص أو مجلد ، مثال :
Call ShowFileAccessInfo("c:My Documentsdo.mdb")
— لتغيير اسم ملف أو مجلد
للملف :
Dim OldName, NewName
OldName = "C:MY Documents1.bmp": NewName = "C:MY Documentsخلفية.bmp"
Name OldName As NewName
للمجلد
Dim OldName, NewName
OldName = "C:MY Documentsمجلد جديد": NewName = "C:MY Documentsاحذفه لو سمحت"
Name OldName As NewName
- لمعرفة نوع المجلد هل هو جذر مجلدات root folder أو مجلد داخل جذر أو مجلد آخر ومستواه
Sub DisplayLevelDepth(pathspec)
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
Dim f, n
Set f = fs.GetFolder(pathspec)
If f.IsRootFolder Then
MsgBox "The specified folder is the root folder."
Else
Do Until f.IsRootFolder
Set f = f.ParentFolder
n = n + 1
Loop
MsgBox "The specified folder is nested " & n & " levels deep."
End If
End Sub
ويحتاج إلى تمرير وسيطة اسم المجلد أو القرص .
— لمعرفة حجم القرص الصلب والمتاح منه
Sub ShowSpaceInfo(drvpath)
Dim fs, d, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName(drvpath)))
s = "Drive " & d.DriveLetter & ":"
s = s & vbCrLf
s = s & "السعة: " & FormatNumber(d.TotalSize / 1024, 0) & " Kbytes"
s = s & vbCrLf
s = s & "المساحة الحرة: " & FormatNumber(d.AvailableSpace / 1024, 0) & " Kbytes"
s = s & vbCrLf
s = s & "المساحة المستخدمة: " & FormatNumber((d.TotalSize - d.AvailableSpace) / 1024, 0) & " Kbytes"
MsgBox s
End Sub
يمكنك استبدال سطر المساحة الحرة بالسطر التالي وهو يؤدي إلى نفس النتيجة :
s = s & "المساحة الحرة: " & FormatNumber(d.FreeSpace / 1024, 0)