انشاء مجلد على سطح المكتب

**Ahmed_J** · ديسمبر 1, 2021

السلام عليكم

عاوز كود لانشاء مجلد (فولدر) على سطح المكتب عن طريق زر بالنموذج

من اي مكان من جهاز الحاسوب

وشكرا

**سامي الحداد** · ديسمبر 1, 2021

وعليكم السلام

تفضل اخي الكريم

بالتوفيق

Create Folder On Desktop.accdb

**د.كاف يار** · ديسمبر 1, 2021

لإنشاء مجلد جديد استخدم الكود التالي

Dim fso As Object, fldrname As String, fldrpath As String
fldrname = " ضع هنا اسم المجلد "
Set fso = CreateObject("scripting.filesystemobject")
    fldrpath = CurrentProject.Path & "\" & fldrname
    If Not fso.FolderExists(fldrpath) Then
       fso.createfolder (fldrpath)
    End If

**Ahmed_J** · ديسمبر 1, 2021

السلام عليكم اساتذتي الاعزاء

استاذ @سامي الحداد استاذ @د.كاف يار شكرا لكم

بالنسبة للمثال الثاني المجلد الجديد يكون بجانب قاعدة البيانات وليس عى سطح المكتب؟

المهم

Dim fso As Object, fldrname As String, fldrpath As String
fldrname = "qq"
Set fso = CreateObject("scripting.filesystemobject")
    fldrpath = CurrentProject.Path & "\" & fldrname
    If Not fso.FolderExists(fldrpath) Then
       fso.CreateFolder (fldrpath)
    End If
fso.CopyFile (fldrpath) \ AA , True' هنا الخطا

لدي ملف داخل قاغدة البيانات الايد نسخة داخل المجلد الحديد qq

ارجو التغديل على السطر الاحير

وشكرا

تم تعديل ديسمبر 1, 2021 بواسطه Ahmed_J

**د.كاف يار** · ديسمبر 1, 2021

تفضل

Dim fso As Object, fldrname As String, fldrpath As String
fldrname = " ضع اسم المجلد هنا "
Set fso = CreateObject("scripting.filesystemobject")
    fldrpath = Environ("USERPROFILE") & "\Desktop\" & fldrname
    If Not fso.FolderExists(fldrpath) Then
       fso.createfolder (fldrpath)
    End If

و لإنشاء مجلد جديد و نسخ مجلد آخر داخل المجلد الجديد

Dim fso As Object, fldrname As String, fldrpath As String, fldrpathNow As String
fldrname = " اسم الجلد الجديد "
fldrpathNow = CurrentProject.Path & "\" & " اسم المجلد بجوار قاعدة البيانات او مسار المجلد " & "\*"
Set fso = CreateObject("scripting.filesystemobject")
    fldrpath = Environ("USERPROFILE") & "\Desktop\" & fldrname
    If Not fso.FolderExists(fldrpath) Then
        fso.createfolder (fldrpath)
        fso.CopyFile fldrpathNow, fldrpath
    End If

تم تعديل ديسمبر 1, 2021 بواسطه د.كاف يار

**Ahmed_J** · ديسمبر 1, 2021

السلام عليكم استاذ @د.كاف يار

اذا ممكن مثال من حظرتك لوسمحت على الكود تبعك

لم يضيط معي الشغل

علما انني انسخ جدول من داخل فاعدة البيانان وليس بجوارها الى داخل المجلد على سطح المكتب

شكرا لكرمك استاذي العزيز

تم تعديل ديسمبر 1, 2021 بواسطه Ahmed_J

**د.كاف يار** · ديسمبر 1, 2021

7 ساعات مضت, Ahmed_J said:

علما انني انسخ جدول من داخل فاعدة البيانان وليس بجوارها الى داخل المجلد على سطح المكتب

كيف يعني تنسخ جدول الى مجلد ؟

تفضل جرب هذا التعديل

On Error GoTo ErrH
Dim fso As Object, fldrname As String, fldrpath As String, fldrpathNow As String
fldrname = "pp2"
Application.FileDialog(msoFileDialogFolderPicker).Show
fldrpathNow = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\*"
Set fso = CreateObject("scripting.filesystemobject")
    fldrpath = Environ("USERPROFILE") & "\Desktop\" & fldrname
    If Not fso.FolderExists(fldrpath) Then
        fso.createfolder (fldrpath)
        fso.CopyFile fldrpathNow, fldrpath
    Else
        MsgBox "تم انشاء المجلد مسبقا", vbExclamation + vbMsgBoxRight, "تنبيه"
    End If
Exit Sub
ErrH:
    MsgBox "رقم الخطأ" & " : " & Err.Number & _
    vbNewLine & "وصف الخطأ" & vbNewLine & Err.Description, vbCritical + vbMsgBoxRight, "تنبيه"

تم تعديل ديسمبر 2, 2021 بواسطه د.كاف يار

**سامي الحداد** · ديسمبر 2, 2021

13 ساعات مضت, Ahmed_J said:

لدي ملف داخل قاغدة البيانات الايد نسخة داخل المجلد الحديد qq

اخوي العزيز

خليتني اضرب اخماس في اسادس وما توصلت للحل شنو المقصود بملف داخل قاعدة البيانات؟ هل تقصد القاعدة اللي جاي تشتفل فيها ؟ القاعدة ككل؟ لان ماكو شئ اسمه ملف داحل قاعدة البيانات.

ارجو التوضيج اكثر او ارفق القاعدة واشرح ماذا تريد بالضبط.

تحياتي

1 دقيقه مضت, سامي الحداد said:

اخماس في اسادس

المقصود اخماس في اسداس بالعراقي ...

**Ahmed_J** · ديسمبر 2, 2021

السلام عليكم اساتذتي الاعزاء

استاذ @سامي الحداد استاذ @د.كاف يار شكرا لكم

انا اسف امس كنت فاتح من الموبايل ولم استطع ارفاق مثال ولم استطيع توضيح الطلب؟

استاذ سامي لاتظرب اخماس باسداس سلامتك

الموضوع بسيط ان شاء اللة

تغببر مكان إنشاء المجلد من ( C) ونسخ الملف داخل المجلد على سطح المكتب وعدم السماح يتكرار الملف او المجلد

نحياتي للجميع

Create Folder .accdb

تم تعديل ديسمبر 2, 2021 بواسطه Ahmed_J

**د.كاف يار** · ديسمبر 3, 2021

تفضل هذا التعديل

Create Folder .accdb

**سامي الحداد** · ديسمبر 3, 2021

1 ساعه مضت, د.كاف يار said:

تفضل هذا التعديل

Create Folder .accdb 432 kB · 2 downloads

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

لك كل التحية والاحترام .

**Ahmed_J** · ديسمبر 3, 2021

السلام عليكم اساتذتي الاعزاء

استاذ @سامي الحداد

استاذ @د.كاف يار نعبتك مغي كثير ☺️ تسلم ايدك على هذه الاكواد

شكرا لكم

المطلوب : إنشاء مجلد Folder2 على سطح المكتب ونسخ الملف Table1 داخلة بصيغة اكسل عن طريق (بيانات خارجية - عمليات التصدير المحفوظة) كما في الصوز

مرفق ملف بعمل بصورة صحيحة على جهاز الحاسوب تبعي؟

لكن لابغمل مع بافي الاجهزة بسبب الكود (\C:\Users\PC\Desktop") يحتلف من جهاز الى اخر (اختلاف اسم المستخدم)

لو امكن كود لسطخ المكتب بغمل مع كل الاجهزة

تحياتي

Create Folder.accdb

تم تعديل ديسمبر 3, 2021 بواسطه Ahmed_J

**د.كاف يار** · ديسمبر 3, 2021

استخدم

Environ("USERPROFILE") & "\Desktop\" & fldrname

**Ahmed_J** · ديسمبر 3, 2021

استاذ @د.كاف يار شكرا كثيرا لك على تعبك معي

بارك الله فيك

لكن الكود لايتوافق مغ عملي في المرفق الاخير (لايعمل)

تحياتي لك

**د.كاف يار** · ديسمبر 4, 2021

تفضل هذا التعديل

Dim fso As New FileSystemObject
If fso.FolderExists(Environ("USERPROFILE") & "\Desktop\" & "\Folder2") Then
Else
fso.CreateFolder (Environ("USERPROFILE") & "\Desktop\" & "\Folder2")
End If
DoCmd.RunSavedImportExport "export"
fso.CopyFile Environ("USERPROFILE") & "\Desktop\" & "Folder2\Table1.xlsx", True

**Ahmed_J** · ديسمبر 4, 2021

السىلام عليكم استاذ @د.كاف يار

تظهر رسالة (فشل غي انشاء ملف)

لا اعرف شو الحل ؟؟؟

تحياتي لك استاذنا العزيز

Create Folder2.accdb

**ناقل** · ديسمبر 4, 2021

23 دقائق مضت, Ahmed_J said:

السىلام عليكم استاذ @د.كاف يار

تظهر رسالة (فشل غي انشاء ملف)

لا اعرف شو الحل ؟؟؟

تحياتي لك استاذنا العزيز

استخدم هذا الكود ......

Dim fso As New FileSystemObject
If fso.FolderExists(Environ("USERPROFILE") & "\Desktop\" & "\Folder2") Then
Else
fso.CreateFolder (Environ("USERPROFILE") & "\Desktop\" & "\Folder2")
End If
'DoCmd.RunSavedImportExport "export"
'fso.CopyFile Environ("USERPROFILE") & "\Desktop\" & "Folder2\Table1.xlsx", True
Output_Path = Environ("USERPROFILE") & "\Desktop\" & "Folder2\Table1.xlsx"
DoCmd.TransferSpreadsheet acExport, , "Table1", Output_Path

او استخدم هذا ,,,,,,

Dim fso As New FileSystemObject
If fso.FolderExists(Environ("USERPROFILE") & "\Desktop\" & "\Folder2") Then
Else
fso.CreateFolder (Environ("USERPROFILE") & "\Desktop\" & "\Folder2")
End If
DoCmd.TransferSpreadsheet acExport, , "Table1", Environ("USERPROFILE") & "\Desktop\" & "Folder2\Table1.xlsx", True

**Ahmed_J** · ديسمبر 4, 2021

استاذي العزيز @ناقل شكرا لاهتمامك

هذه الطريقة اعرفها

لابد من استخدام هذه الطريفة بالصور

تحباتي لك

**د.كاف يار** · ديسمبر 5, 2021

تفضل التعديل

On Error GoTo ErrH
Dim fso As New FileSystemObject
    If fso.FolderExists(Environ("USERPROFILE") & "\Desktop\Folder2") = True Then
        fso.DeleteFolder (Environ("USERPROFILE") & "\Desktop\Folder2")
    Else
        fso.CreateFolder (Environ("USERPROFILE") & "\Desktop\Folder2")
    End If
    DoCmd.RunSavedImportExport "export"
    fso.CopyFile Environ("USERPROFILE") & "\Desktop\Folder2\Table1.xlsx", True
Exit Sub
ErrH:
MsgBox "Err Number : " & Err.Number & vbNewLine & "Err Description :" & _
vbNewLine & Err.Description, vbCritical

**Ahmed_J** · ديسمبر 5, 2021

السىلام عليكم استاذ @د.كاف يار

انا والله حجلان جدا منك لانني تعبتك كتير

الكود لايعل نظهر الرسالة كما في الصورة

لو في حل ؟ الرجاء التعديل على الملف المرفق يكون افضل

وشكرا

Create Folde.accdb

تم تعديل ديسمبر 5, 2021 بواسطه Ahmed_J

**ابو جودي** · ديسمبر 5, 2021

اتفضل جرب

Create Folde.accdb

**Ahmed_J** · ديسمبر 5, 2021

أستاذ @ابو جودي

شكرا جزيلا لك

لاتخدم عملي سوى الطريقة التي يالصور والملف المرقق

نحياتي لك

المشكلة فقط في هذا الكود باللون الاحمر"C:\Users\Public\Desktop\Folder2\Table1.xlsx"

هو يعمل على جهاز الحاسوب نيعي لكن لايعمل مع باقي الاجهزة الاخرى

"C:\Users\Public\Desktop\Folder2\Table1.xlsx"

Create Folder.accdb

تم تعديل ديسمبر 5, 2021 بواسطه Ahmed_J

**ابو جودي** · ديسمبر 5, 2021

اتفضل

هذا السطر به حل مشكلتك

Dim strDesktopPath  As String: strDesktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")

حيث انه تم اسناد مسار سطح المكتب الى المتغير strDesktopPath
يمكنك استدعاء المسار من خلال المتغير strDesktopPath

انشئ زر امر وضع الكود الاتى يظهر لك مسار المجلد الخاص بسطح المكتب

Dim strDesktopPath  As String: strDesktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
MsgBox (strDesktopPath)

بعذ ذلك ما يأتى من كود يخصك انت

تم تعديل ديسمبر 5, 2021 بواسطه ابو جودي

**Ahmed_J** · ديسمبر 5, 2021

استاذ @ابو جودي

انا اسف من الجميع على نعبكم معي

فقط اريد ان اوضح عمل الملف الاصلي

هو يعمل بصورة صحيحة جدا عن التصدير الى اي قسم من اقسام الهارد كما في الملف الاصلي

عن طريق حفظ مسار الملف عن طريق (بيانات خارجية - عمليات التصدير المحفوظة) كما في الصوز

قم بتجربة الملف الاصلي سيقوم بحفظ الملف مع الفولدر بصورة صحيحة في :C

اريد ان يجعل الحفظ على سطح المكنب

نحياتي لك استاذ

الملف الاصلي.accdb

**ابو جودي** · ديسمبر 5, 2021

انت مش مشكلتك فى مسار سطح المكتب

انت مشكلتك فى طريقة التصدير الغريبة بتاعتك وده مش تصدير دا امر نسخ وبصراحة انا مش فاهمه شغال ازاى ومن فين

ضبط كودك او ابحث

Dim fso As New FileSystemObject
Dim strDesktopPath  As String: strDesktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")


If fso.FolderExists(strDesktopPath & "\Folder2") Then
Else
fso.CreateFolder (strDesktopPath & "\Folder2")
End If

DoCmd.RunSavedImportExport "export"
Dim strExportPath As String: strExportPath = strDesktopPath & "\Folder2\Table1.xlsx"

fso.CopyFile strExportPath, True

تسجيل الدخول

انشاء مجلد على سطح المكتب

الردود الموصى بها

Ahmed_J

سامي الحداد

د.كاف يار

Ahmed_J

د.كاف يار

Ahmed_J

د.كاف يار

سامي الحداد

Ahmed_J

د.كاف يار

سامي الحداد

Ahmed_J

د.كاف يار

Ahmed_J

د.كاف يار

Ahmed_J

ناقل

Ahmed_J

د.كاف يار

Ahmed_J

ابو جودي

Ahmed_J

ابو جودي

Ahmed_J

ابو جودي

Join the conversation

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information