كود لإنشاء ملف نصي في مجلد النظام system

[فتحي محمد]

الأساتذة الفضلاء دام عزكم واسعد الله صباحكم بكل الخير 

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

اريد من حضراتكم كود يقوم بإنشاء ملف نصي وليكن fs txt مكتوب داخله"fs" ويكون مساره داخل مجلد الويندوز علي الجهاز ولحضراتكم مني جزيل الشكر

[أ / محمد صالح]

عليكم السلام ورحمة الله وبركاته
يمكنك تجربة  كود VBA يقوم بإنشاء ملف نصي باسم **fs.txt** يحتوي على النص `"fs"`، ويتم حفظه داخل مجلد **C:\Windows** على الجهاز:

 

Sub CreateTextFile()
    Dim FilePath As String
    Dim FileNumber As Integer
    
    ' تحديد مسار الملف داخل مجلد Windows
    FilePath = "C:\Windows\fs.txt"
    
    ' الحصول على رقم ملف متاح
    FileNumber = FreeFile
    
    ' إنشاء وكتابة البيانات إلى الملف
    Open FilePath For Output As FileNumber
    Print #FileNumber, "fs"
    Close FileNumber
    
    MsgBox "تم إنشاء الملف بنجاح في: " & FilePath, vbInformation, "نجاح"
End Sub

```

⚠️ **ملاحظة:** تحتاج إلى تشغيل الكود بصلاحيات **المسؤول (Administrator)** لأن الكتابة داخل مجلد **Windows** تتطلب أذونات خاصة. يمكنك تشغيل VBA من داخل **Excel أو Word** ولكن تأكد من أن لديك الصلاحيات الكافية.

بالتوفيق
 

[فتحي محمد]

السلام عليكم  اخي الفاضل جزاك الله خير وجعله الله زخرا لك في الاخرة

غير ان هناك مشكلة عند تشغيل الكود موجودة في الصور المرفق

[فتحي محمد]

[عبدالله بشير عبدالله]

السلام عليكم

انتبه الى الملاحظة التي كتبها معلمنا الاستاذ محمد صالح

في 21‏/4‏/2025 at 10:49, أ / محمد صالح said:

ملاحظة:** تحتاج إلى تشغيل الكود بصلاحيات **المسؤول (Administrator)** لأن الكتابة داخل مجلد **Windows** تتطلب أذونات خاصة

مجلد C:\Windows هو مجلد نظام، ولا يُسمح للبرامج العادية (بدون صلاحيات مسؤول) بإنشاء أو تعديل ملفات بداخله

وهذا هو سبب  ظهور الخطأ

 بالماوس الايمن على تطبيق اكسل وليس ملف الاكسل قم باختيار تشغيل كمسؤول  وسيعمل الكود وينشئ الملف وقد فمت بالتجرية وكانت تاجحة بالتمام والكمال

 نحياني

[محمدسلام]

شكرا علي التوضيح جزاكم الله خيرا

[فتحي محمد]

شكرا جزيلا لكل من تفضل بالرد والمساهمة في حل المشكلة جعله الله في ميزان حسناتكم

[Foksh]

مساهمة بعد تعديلها لتعمل على اكسل بدلاً من اكسيس ولست متأكد منها :-

في وحدة نمطية جديدة =

Option Compare Database


#If VBA7 Then
    Private Declare PtrSafe Function OpenProcessToken Lib "advapi32.dll" ( _
        ByVal ProcessHandle As LongPtr, _
        ByVal DesiredAccess As Long, _
        ByRef TokenHandle As LongPtr _
    ) As Long

    Private Declare PtrSafe Function GetTokenInformation Lib "advapi32.dll" ( _
        ByVal TokenHandle As LongPtr, _
        ByVal TokenInformationClass As Long, _
        ByRef TokenInformation As Any, _
        ByVal TokenInformationLength As Long, _
        ByRef ReturnLength As Long _
    ) As Long

    Private Declare PtrSafe Function GetCurrentProcess Lib "kernel32" () As LongPtr

    Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
        ByVal hwnd As LongPtr, _
        ByVal lpOperation As String, _
        ByVal lpFile As String, _
        ByVal lpParameters As String, _
        ByVal lpDirectory As String, _
        ByVal nShowCmd As Long _
    ) As LongPtr
#Else
    Private Declare Function OpenProcessToken Lib "advapi32.dll" ( _
        ByVal ProcessHandle As Long, _
        ByVal DesiredAccess As Long, _
        ByRef TokenHandle As Long _
    ) As Long

    Private Declare Function GetTokenInformation Lib "advapi32.dll" ( _
        ByVal TokenHandle As Long, _
        ByVal TokenInformationClass As Long, _
        ByRef TokenInformation As Any, _
        ByVal TokenInformationLength As Long, _
        ByRef ReturnLength As Long _
    ) As Long

    Private Declare Function GetCurrentProcess Lib "kernel32" () As Long

    Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
        ByVal hwnd As Long, _
        ByVal lpOperation As String, _
        ByVal lpFile As String, _
        ByVal lpParameters As String, _
        ByVal lpDirectory As String, _
        ByVal nShowCmd As Long _
    ) As Long
#End If

Public Function IsRunAsAdmin() As Boolean
    Const TOKEN_QUERY      As Long = &H8
    Const TokenElevation   As Long = 20
    Dim hToken            As LongPtr
    Dim elev              As Long
    Dim retLen            As Long

    If OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, hToken) <> 0 Then
        If GetTokenInformation(hToken, TokenElevation, elev, LenB(elev), retLen) <> 0 Then
            IsRunAsAdmin = (elev <> 0)
        End If
    End If
End Function

Public Sub RestartAsAdmin()
    Dim exePath   As String
    Dim dbArgument As String

    exePath = Application.FullName
    dbArgument = """" & Application.CurrentProject.FullName & """"

    ShellExecute 0, "runas", exePath, dbArgument, vbNullString, 1

    Application.Quit
End Sub

Public Sub CreateTextFile()
    Dim FilePath   As String
    Dim FileNum    As Integer

    If Not IsRunAsAdmin Then
        MsgBox "البرنامج بحاجة إلى صلاحيات مسؤول (Administrator)." & vbCrLf & _
               "سيتم إعادة تشغيل Access بطلب صلاحيات مرتفعة...", _
               vbExclamation, "تحتاج صلاحيات"
        RestartAsAdmin
        Exit Sub
    End If

    FilePath = "C:\Windows\fs.txt"
    FileNum = FreeFile

    Open FilePath For Output As #FileNum
    Print #FileNum, "fs"
    Close #FileNum

    MsgBox "تم إنشاء الملف بنجاح في:" & vbCrLf & FilePath, _
           vbInformation, "نجاح"
End Sub

 

الإستدعاء سيكون في الزر على سبيل المثال =

CreateTextFile

 

[فتحي محمد]

معذرتة استاذ foksh يتم استدعاء ايه بالظبط من الفات دا كله معلش انا مش خبير والامكنتش صدعت دماغكم وهل ممكن حضرتك تعمله علي ملف اكسل وترفعه دا لو مش حاتعب حضرتك ولك مني كامل الاحترام والتقدير