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

إنشاء مجلد على مسار محدد وحفظ ملف الاكسل عليه


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

تحياتي لجميع المشرفين والعلماء والخبراء في هذا الصرح المتميز

المطلوب من هذا الملف هو عند الضغط على زر (حفظ الملف ) يتم تفحص المسارات

C:\data , D:\data , E:\data

وتفقد المجلد data بالأخص على المسارات المذكورة

فإذا لم تكن المجلدات ذات الاسم data موجودة على المسارات المحددة أو أحدها يتم إنشاؤه على المسار تلقائيا وحفظ ملف الاكسل عليها جميعا

ولكم جزيل الشكر والتقدير

إنشاء مجلد على مسار محدد وحفظ ملف الاكسل عليه.rar

رابط هذا التعليق
شارك

شكرا أخي ابو احمد راجعت الرابط ولكنه لم يف بالغرض لأني أريد حفظ الملف على المسار المحدد بدون أن يطلبني تحديد مكان الحفظ بفورم

وجدت طريقة أخرى على المنتدى على الرابط http://www.officena....=1

وقمت بتعديل الكود إلى التعديل التالي ليتناسب مع مطلبي ولا أعلم إن كان هذا الكود طويل أم لا ولكنه قام بالواجب وتم تنفيذ المطلوب بشكل ممتاز

وإذا كان هناك تعديل على الكود أرجو إفادتي ولكم جزيل الشكر

Sub copy1()

Dim Extension$

Dim savePathName As String

Extension = ThisWorkbook.Name

savePathName = "c:\data\"

	On Error Resume Next

	Application.DisplayAlerts = False

	GetAttr (savePathName)

	Select Case Err.Number

	Case Is = 0

			Application.DisplayAlerts = False

			ThisWorkbook.SaveCopyAs savePathName & Extension

			Application.DisplayAlerts = True

	Case Else

			MkDir savePathName

			ThisWorkbook.SaveCopyAs savePathName & Extension

	End Select

	On Error GoTo 0


	Extension = ThisWorkbook.Name

savePathName = "d:\data\"

	  On Error Resume Next

	Application.DisplayAlerts = False

	GetAttr (savePathName)

	Select Case Err.Number

	Case Is = 0

			Application.DisplayAlerts = False

			ThisWorkbook.SaveCopyAs savePathName & Extension

			Application.DisplayAlerts = True

	Case Else

			MkDir savePathName

			ThisWorkbook.SaveCopyAs savePathName & Extension

	End Select

	On Error GoTo 0


End Sub

شكرا أخي ابو احمد على تعاونك

شكرا للجميع

رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



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

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information