نقل محتويات مجلد من مسار إلى آخر

[حسن محمد]

السلام عليكم ورحمة الله وبركاته ..

إخواني لدي ملفات داخل مجلد وأرغب نقله عبر زر أمر إلى مجلد آخر بمعنى (الملفات التي بداخل مجلد A) إلى ( مجلد B)

ومرفق مثال تقريبي منقول الأستاذ (العمري بن - منتدى الفريق العربي للبرمجة) . آمل التعديل عليه إن أمكن ولكم الشكر .

xTIME.rar

[محب العلم]

حسن ،

لقد صممت لك أداة تناقل الملفات بين مجلدين ثابتين A و B في مثالنا وهما في الدليل الرئيسي \:C أنظر الصورة

وتقوم الأدارة بإظهار الملفات الموجودة في الدليل A في مربع قائمة List1 وإظهار الملفات الموجودة في الدليل B في مربع قائمة List2 ثم تستطيع تحديد ملف أو عدة ملفات وبمجرد الضغط على زر النقل المناسب من a إلى b أو العكس سيتم المطلوب وسيظهر أثر ذلك في مربعي القائمة مباشرة

SL20890.rar

لا تنسى لتجربة المثال أن تنشىء المجلد c:\a والمجلد c:\b وتضع ملفات في واحد منهما على الأقل

تحياتي

تم تعديل ديسمبر 19, 2007 بواسطه محب العلم

[حسن محمد]

أستاذ محب العلم حفظك الله

نعم هذا المطلوب وجزاك الله خيراً وسامحني أود أن أثقل عليك قليلاً

1 - إذا كان داخل المجلد من مجلدات بمعنى لو كان تحت المجلد A مجلدات داخله لانستطيع نقلها وهذه تمثل مشكلة بالنسبة لي .

2 - رسالة بما تم نقله من A إلى B والعكس (المرسل ... ، المرسل إليه ... ، التاريخ : ..... ، الوقت ...... ، أسماء الملفات المرسلة ......... ) .

وجزاك الله خيراً بإنتظار ردكم على إستفساري وفقكم الله .

أخوكم أبوأحمد المدينة المنورة .

[محب العلم]

أبا أحمد ،

الحقيقة أن الموضوع يحتاج إلى جهد ، يبدو لي أن ما تطلبه ممكن التحقيق

انصحك بالاضافة إلى الأداة التي صممتها لك أن تبحث في الكائن FileSystemObject

على سبيل المثال في هذا الكائن بإمكانك أن تعرف معلومات الدليل كالأتي :

Dim fs, f, s
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set f = fs.getfolder("c:\a")
  s = f.DateCreated
  MsgBox s

وفي هذا الكائن يوجد طرق مثل Movefile و Movefolder

ولكن الموضوع يحتاج إلى تنظيم وبحث

دعواتكم من المدينة المنورة

[حسن محمد]

السلام عليكم رحمة الله وبركاته ...

أخي الأستاذ محب العلم كل عام وأنتم بخير .

الحقيقة الدعاء لكل مسلم هو غايتنا إنشاء الله وأما الدعاء لمن قام بمساعدة الأخرين فهذا أدعى وأبر ويكفيك ( إن لله عباداً أختصمهم بقضاء حوائج الناس ، حببهم في الخير وحبب الخير إليهم إنهم الآمنون من عذاب الله يوم القيامة) فهنيأ لكل من ساعد أو أرشد أو فكر أو أبدى برأي في سبيل قضاء حاجة أخيه . وفقك يا أخي الأستاذ محب العلم .

أما فيما يخص وضع الكود في الأداة فكنت أتمنى مساعدتي بوضه في المثال لكي أتأكد من صحة عمل المثال حيث أني قليل الخبرة في ذلك بالنسبة للأكسس . فأرجو مساعدتي بتعديل المثال جزاكم الله خيراً .

أخوكم الصغير أبوأحمد من المدينة المنورة .

[حسن محمد]

مازلت أنتظر من إخواني إجابتي على طرحي وفقكم الله تعالى .

[محب العلم]

حسن ،

أعرف أنك ما زلت تحتاج إلى نقل المجلدات وما زلت أبحث عن الطريقة المثلى لذلك ولم أتوصل لها بعد .

إليك الأجراء الأتي ايضا من الأساليب الممتازة في في نسخ الملفات من دليل إلى أخر دون المجلدات

 

Private Sub Command0_Click()

Dim sSourceDir As String
Dim sBackDir As String
Dim sNextFile As String

On Error GoTo FileCopyError

'غير اسماء المصدر والهدف حسب الرغبة
sSourceDir = "C:\a\"
sBackDir = "c:\b\"

sNextFile = Dir$(sSourceDir & "*.*")

While sNextFile <> ""
    FileCopy sSourceDir & sNextFile, sBackDir & sNextFile
    sNextFile = Dir$
Wend

MsgBox "تمت عملية النسخ"

Exit Sub

FileCopyError:
 MsgBox "هناك خطأ في عملية النسخ"
End

End Sub

اذا أردت النقل بدل النسخ فكما فعلنا في المثال الأول في مشاركتي قبل السابقة تستخدم الأمر Kill

تحياتي

[محب العلم]

حسن ،

وهذا الملف في word فيه شرح بالانجليزية تم ترجمته فوريا بواسطة مترجم google المقبول نسبيا.

فيه شروحات عن استخدام أوامر الملفات باستخدام VB فد بساعدك في الوصول للحل

الملف : File_Functions_in_Visual_Basic.doc

تحياتي

[حسن محمد]

أستاذي محب العلم وفقك الله تعالى

لقد أستفدت من الأكواد التي قمت بإرفاقها لي وأما الكود الأول فالحقيقة لا أدري أين أضعه في المثال المرفق من قبلك لكي أتأكد بأنه هو الذي أريد . آمل أن تضعه في المثال أو أن تخبرني أين يوضع هذا الكود .

آسف أستاذي على إشغالك ولكن لا أملك لك سوى الدعاء .

أخوك الصغير أبوأحمد المدينة المنورة .

[حسن محمد]

أستاذي محب العلم وفقك الله تعالى

لقد أستفدت من الأكواد التي قمت بإرفاقها لي وأما الكود الأول فالحقيقة لا أدري أين أضعه في المثال المرفق من قبلك لكي أتأكد بأنه هو الذي أريد . آمل أن تضعه في المثال أو أن تخبرني أين يوضع هذا الكود .

آسف أستاذي على إشغالك ولكن لا أملك لك سوى الدعاء .

أخوك الصغير أبوأحمد المدينة المنورة .

[محب العلم]

أبا أحمد،

ما زالت المتابعة جارية

وهذا كود أخر باستخدام Scripting.FileSystemObject لنقل الملفات دون المجلدات من مجلد إلى أخر

اعتقد أننا اقتربنا مما نصبو إليه فصبرا ...

 

Private Sub copyfiles_Click()


Dim objFS As Object, objFolder As Object
Dim objFiles As Object, objF1 As Object
Dim strFill As String, strFolderPath As String
Dim strFolderPath, strFolderTO As String


strFolderPath = "C:\from\"
sttFolderTo = "c:\to\"

Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder(strFolderPath)
Set objFiles = objFolder.Files


For Each objF1 In objFiles
  objFS.CopyFile strFolderPath & objF1.Name, strFolderTO
Next

Set objF1 = Nothing
Set objFiles = Nothing
Set objFolder = Nothing
Set objFS = Nothing

End Sub

تحياتي

[BMW2010]

أدام الله هذا الموقع

ووفق الله القائمين عليه وجعله في موازين حسناتهم

شهر كامل وأنا ادور لكود زي كذا والحمد لله لقيته عندكم

بارك الله فيكم وزادكم في الدين والدنيا وفي العلم

[محب العلم]

شهر كامل وأنا ادور لكود زي كدا والحمد لله لقيته عندكم

أرأيتم إخواني لماذا أنا حريص على تسجيل كل ما أتوصل اليه في مسألة ما حتى وإن لم يصيب الهدف مباشرة، ذلك لأنه يمكن أن يفيد أحرين بالإضافة لصاحب المشاركة الأساس.

تحياتي

[حسن محمد]

جزاك الله خيراً أخي محب العلم ونفع بعلمكم .

أتمنى مساعدتي أيضاًُ بطلبي وفقكم الله .

[محب العلم]

الأخ حسن محمد ،

أطمئن اقتربنا بكل تأكيد من الحل ...

هذا الكود يمكننا من الدوران في كل الملفات التي في مجلد معين وتغيير خاصية للقراءة فقط لها ... المفيد بالنسبة لنا هو الدوران في كل الملفات والمجلدت التي داخل مجلد وهذا هو مفتاح الحل بالتأكيد طبعا هذا باللإضافة لأحد الأكواد التي تم تجميعها سابقا

 

Public d As Integer

Private Sub Command0_Click()
Set oFs = CreateObject("Scripting.FileSystemObject")
strFolder = "C:\Test"

Set oDir = oFs.GetFolder(strFolder)
o = 0: d = 0
ScanAllSubDirs oDir
MsgBox o & " File controllati" & vbCr & _
"Readonly was removed " & d & " times" & vbCr & _
"in """ & strFolder & """", (Sgn(d) * 16) + 48, "DONE"


End Sub
Sub ScanAllSubDirs(oFolder)
For Each ofile In oFolder.files
DimReadOnly ofile
MsgBox ofile
Next
For Each oSubFolder In oFolder.subFolders
DimReadOnly oSubFolder
ScanAllSubDirs oSubFolder
Next
End Sub

Sub DimReadOnly(ByRef objDat)
o = o + 1
If objDat.Attributes Mod 2 = 1 Then
objDat.Attributes = objDat.Attributes - 1
d = d + 1
End If
End Sub

تحياتي

[محب العلم]

الاخ حسن محمد ،

وأخيرا توصلت إلى الحل المطلوب وهو هكذا

 

Private Sub Command1_Click()


Dim FSO As Object, fsoFolder As Object
Dim strOldFolder As String
Dim strNewFolder As String

'Set variables
Set FSO = CreateObject("Scripting.FileSystemObject")
strOldFolder = Me.FromFolder
strNewFolder = Me.ToFolder

'Test for folder existence
If FSO.FolderExists(strOldFolder) Then
Set fsoFolder = FSO.GetFolder(strOldFolder)

'Check for new folder existence, create if not
If Not FSO.FolderExists(strNewFolder) Then
 FSO.CreateFolder (strNewFolder)
End If

'Copy folder contents
On Error Resume Next
FSO.CopyFolder Source:=strOldFolder, Destination:=strNewFolder

End If

End Sub

وإليك المثال : CopyFolder.rar

تحياتي

[حسن محمد]

أستاذي محب العلم

الحقيقة لا أعرف كيف أتقدم لكم بالشكر على هذا الجهد الذي عملته معي للتوصل للحل المطلوب ولكن لا أملك سوى الدعاء لكم بأن يجعل الجنة مثواك مع النبيين والصديقين والشهداء وحسن أولئك رفيقاً وأن يزوجك من الحور العين .

نعم يا أستاذي هذا هو المطلوب مع بعض الإضافات التي أتمنى توصيلي لها وهي :

1 - إن أمكن أن لا يكون النسخ وإنما النقل (cut) ووضعه في المجلد الآخر .

2 - أن يعطيني تقرير بأسماء الملفات والمجلدات التي تم تحويلها للموقع الآخر (إن أمكن) .

ولكي مني الشكر والدعاء مرة ثانية .

وفقك الله تعالى يا أستاذي محب العلم .

أخوك وتلميذك أبوأحمد المدينة المنورة .

[محب العلم]

بارك الله فيك أخي أبا احمد وإن شاء الله سأعمل كل ما طلبته قريبا

تحياتي لك

[حسن محمد]

أستاذي محب العلم وفقه الله

أرجو أن يكون ذلك في نفس المثال الذي سبق وأن أرفقته بحيث يعرض لي محتويات المجلد الخاص بالطرف الآخر . كما أرجو أن يتم وضع رسالة الخطأ في حالة عدم إكتمال النقل أو النسخ .

أشكرك مرة أخرى على سعة صدرك . معليش أستاذي تحمل طلابك .

[أبا عمر]

يُنقل 
.....