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

[Ahmed_J]

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

مع الاسف لم يضبط معي

شكرا لك كثيرا استاذنا الغالي

[ناقل]

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

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

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

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

تحباتي لك

   

 

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

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

مع الاسف لم يضبط معي

شكرا لك كثيرا استاذنا الغالي

طيب شوف التحايل هذا .......

Dim fso As New FileSystemObject
Dim LExcelOriginal      As String
Dim LExcelCopyOf        As String
Dim msgstyle
    If fso.FolderExists(Environ("USERPROFILE") & "\Desktop\" & "\Folder2") Then
    Else
        fso.CreateFolder (Environ("USERPROFILE") & "\Desktop\" & "\Folder2")
    End If
DoCmd.RunSavedImportExport "export"
    LExcelOriginal = "D:\Table1.xlsx"
    LExcelCopyOf = Environ("USERPROFILE") & "\Desktop\" & "Folder2" & "\" & "Table1.xlsx"
    FileCopy LExcelOriginal, LExcelCopyOf
    Kill ("D:\Table1.xlsx")
MsgBox Space(20) & "تمت العملية بنجاح.." & Space(20), msgstyle, "للمعلومية"

 

ملفك بد التعديل ....

 

Create Folder2 (1).accdb

[Ahmed_J]

استاذ @ناقل

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

تحايل في مكانه 

بارك الله فيك وفي كافة الاساتذة اللي ساعدوني بخبراتهم الرائعة

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

 

 

[ابو جودي]

18 دقائق مضت, ناقل said:

طيب شوف التحايل هذا .......

بضحك لأنى كنت ناوى أقول جرب الكود هذا
وكنت متردد 

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")

DoCmd.RunSavedImportExport "export"

Dim ExceToLocC As String: ExceToLocC = "C:\Table1.xlsx"
Dim ExcelCopy As String: ExcelCopy = strDesktopPath & "\Folder2\Table1.xlsx"

FileCopy ExceToLocC, ExcelCopy: Kill ("C:\Table1.xlsx")

 

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

[Ahmed_J]

استاذي الكبير @ابو جودي

شكرا كثيرا لك

بارك الله فيك ويحفظك من كل مكروه

 

[ناقل]

38 دقائق مضت, ابو جودي said:

بضحك لأنى كنت ناوى أقول جرب الكود هذا
وكنت متردد 

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")

DoCmd.RunSavedImportExport "export"

Dim ExceToLocC As String: ExceToLocC = "C:\Table1.xlsx"
Dim ExcelCopy As String: ExcelCopy = strDesktopPath & "\Folder2\Table1.xlsx"

FileCopy ExceToLocC, ExcelCopy: Kill ("C:\Table1.xlsx")

 

لان اسلوب اخونا احمد غريب شوي في تصدير الاكسيل .....

لذلك حاولت التحايل على الفكرة ......

ما شاء الله عليك ابا جودي .... معلم واستاذ ... جزاك الله خيرا ...

[ابو جودي]

18 دقائق مضت, ناقل said:

لذلك حاولت التحايل على الفكرة ......

حلو التفكير بره الصندوق 

الفكرة ممتازة

بس سبب ترددى فى وضع الكود لو الاكسس عللق كما يحدث احيانا ولم يتم مسح ملف الاكسل وكنت لسه بافكر وادورها براسى وحضرتك ما شاء الله وضعت الحل

[ناقل]

ممكن نضع في بداية الكود 

شيفرة تتاكد من عدم وجود ملف الاكسل ... واذا كان موجود يحذفه اولا ثم يتابع

[سامي الحداد]

مشاركة مع الحبايب 

يا ليت تعطوني رايكم 

تحياتي

 

MyFolder.accdb