المساعدة في حفظ الملفات سواءا بي دي اف او صورة في مجلداتها حسب الاختيار من البرنامج وارد او صادر

[العنزي العنزي]

السلام عليكم اساتذتي الافاضل ورحمة الله وبركاته جمعة مباركة طيبة عليكم جميعا 

طلبي هو عندما ادخل بيانات كتاب ما واختار من البرنامج مثلا نوع الكتاب وارد يتم الحفظ داخل مجلد الوارد الموجود في مجلد ال Files وايضا اذا تم اختيار صادر من البرنامج يتم الحفظ في مجلد الصادر الموجود 

في المجلد الرئيسي Files ويكون البحث من المجلدين سواءا اذا اردنا البحث عن كتاب وارد نبحث عنه في المجلد وارد لكي نقوم بطباعته وهكذا بالنسبة للصادر نفس العمل مع وافر التحايا 

وهذا البرنامج في المرفقات

ARCHFAB-11.rar

[العنزي العنزي]

up

[Foksh]

تفضل أخي @العنزي العنزي ، تم إجاء تعديلات على زر اختيار ملف الـ PDF ، وعلى زر الحفظ :-

في زر اختيار الملف :-

On Error GoTo err:
Dim dbox As Office.FileDialog
Set dbox = Application.FileDialog(msoFileDialogFilePicker)
With dbox
.Title = "PDF"
.Filters.Clear
.Filters.Add "PDF files", "*.PDF"
.AllowMultiSelect = False
.Show
book_Bath = .SelectedItems(1)
Me.Image1.Picture = Me.book_Bath
Me.Image1.Requery
End With
    Set dbox = Nothing
err: DoCmd.CancelEvent

 

وفي زر الحفظ :-

If IsNull(book_Num) Then
    Beep
    MsgBox "رقم الكتاب مطلوب"
    Exit Sub
End If
Dim targetFolder As String
If Me.book_Type = "وارد" Then
    targetFolder = CurrentProject.Path & "\Files\Wared"
ElseIf Me.book_Type = "صادر" Then
    targetFolder = CurrentProject.Path & "\Files\Sader"
Else
    MsgBox "نوع الكتاب غير معروف"
    Exit Sub
End If
If Dir(targetFolder, vbDirectory) = "" Then
    MkDir targetFolder
End If
SourceFile = Me.book_Bath
strmyfile = Right(book_Bath, Len(book_Bath) - InStrRev(book_Bath, "."))
DestinationFile = targetFolder & "\" & Me.book_Num & "." & strmyfile
FileCopy SourceFile, DestinationFile
MsgBox "تم حفظ الكتاب"
Me.Requery

 

myArchfa.zip

[العنزي العنزي]

السلام عليكم استاذي الفاضل Foksh ورحمة الله وبركاته

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

استاذي الفاضل هناك مشكلتين 

1 - هي عند استدعاء ملف ال بي دي اف من الحاسوب لكي اسجل رقمه وتريخه لن يظهر في شاشة البرنامج 

2 - عند البحث برقم الكتاب او موضوعه ايضا لايظهر عند النقر على زر امر عرض حتى يتسنى لي طباعته 

مع وافر التحايا 

 

[Foksh]

منذ ساعه, العنزي العنزي said:

السلام عليكم استاذي الفاضل Foksh ورحمة الله وبركاته

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

استاذي الفاضل هناك مشكلتين 

1 - هي عند استدعاء ملف ال بي دي اف من الحاسوب لكي اسجل رقمه وتريخه لن يظهر في شاشة البرنامج 

2 - عند البحث برقم الكتاب او موضوعه ايضا لايظهر عند النقر على زر امر عرض حتى يتسنى لي طباعته 

مع وافر التحايا 

 

شوف هذا التعديل هو المطلوب ؟؟

myArchfa.accdb

[العنزي العنزي]

استاذي الفاضل Foksh الله يحفظك ويبارك بعمرك يا طيب جزاك الله خيرا اللهم ربي يبعد عنك كل شر يارب 

بقي فقط البحث انظر للصورة المرفقة طلبي هو عند الدخول الى نموذج البحث وادخال رقم الكتاب او موضوع الكتاب والضغط على 

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

هذه الصورة في المرفقات . علما ان الكتاب محفوظ في الجدول مع جزيل الشكر والامتنان

 

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

السلام عليكم

مشاركة مع الاستاذ  @Foksh جزاه الله خيرا 

اليك التعديل حسب ما طلبت

Private Sub cmdSave_Click()
    If IsNull(Me.book_Bath) Or Me.book_Bath = "" Then
        MsgBox "الملف غير محدد"
        Exit Sub
    End If

    SourceFile = Me.book_Bath
    Dim targetFolder As String
    If Me.book_Type = "وارد" Then
        targetFolder = CurrentProject.Path & "\" & "\Files\Wared\"
    ElseIf Me.book_Type = "صادر" Then
        targetFolder = CurrentProject.Path & "\" & "\Files\Sader\"
    Else
        MsgBox "نوع الكتاب غير معروف"
        Exit Sub
    End If
    
    If Dir(targetFolder, vbDirectory) = "" Then
        MkDir targetFolder
    End If
Dim fileExt As String
fileExt = Split(SourceFile, ".")(UBound(Split(SourceFile, ".")))

DestinationFile = targetFolder & "\" & Me.book_Num & "." & fileExt
FileCopy SourceFile, DestinationFile
Me.book_Bath = DestinationFile
Me.imageType = fileExt
MsgBox "تم حفظ الكتاب"
Me.Requery

End Sub


Private Sub ComView_Click()
    On Error Resume Next
    If IsNull(book_Num) Then
        Beep
        MsgBox "رقم الكتاب مطلوب"
        Exit Sub
    End If
    If IsNull(Me.imageType) Then
        MsgBox "نوع الصورة مطلوب"
        Exit Sub
    End If
    
    Dim filePath As String
    Dim fileName As String
    Dim foundFilePath As String
    
    fileName = Me.book_Num & "." & Me.imageType
    foundFilePath = FindFile(CurrentProject.Path & "\Files\", fileName)
    
    If foundFilePath = "" Then
        MsgBox "لا يوجد كتاب"
        Exit Sub
    End If
    
    ShellExecute Me.hwnd, "open", foundFilePath, "", "", 1
End Sub

Function FindFile(ByVal folderPath As String, ByVal fileName As String) As String
    Dim fso As Object
    Dim folder As Object
    Dim subFolder As Object
    Dim file As Object
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(folderPath)

    For Each file In folder.Files
        If file.Name = fileName Then
            FindFile = file.Path
            Exit Function
        End If
    Next file
    
    For Each subFolder In folder.SubFolders
        FindFile = FindFile(subFolder.Path, fileName)
        If FindFile <> "" Then Exit Function
    Next subFolder
    
    Set fso = Nothing
    Set folder = Nothing
    Set subFolder = Nothing
    Set file = Nothing
    FindFile = ""
End Function

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

بالتوفيق

MyArchfa.rar

[العنزي العنزي]

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

كلمة شكرا قليلة في حقك جزاك الله خيرا اللهم ربي يحفظك ويمن عليك بالصحة والعافية والشكر موصول للاستاذ الفاضل Foksh جزاه الله خيرا

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

عندها تخرج رسالة تم الحفظ كما في الصورة الثانية 

طلبي هو فقط الغاء هذه الرسالة الاولى ويبقى فقط رسالة تم الحفظ مع جزيل الشكر والامتنان 

وهذه الصور في المرفقات : 

 

وهذه الصورة الثانية التي اريد ابقائها 

 

[Foksh]

2 ساعات مضت, العنزي العنزي said:

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

كلمة شكرا قليلة في حقك جزاك الله خيرا اللهم ربي يحفظك ويمن عليك بالصحة والعافية والشكر موصول للاستاذ الفاضل Foksh جزاه الله خيرا

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

عندها تخرج رسالة تم الحفظ كما في الصورة الثانية 

طلبي هو فقط الغاء هذه الرسالة الاولى ويبقى فقط رسالة تم الحفظ مع جزيل الشكر والامتنان 

وهذه الصور في المرفقات : 

 

وهذه الصورة الثانية التي اريد ابقائها 

 

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

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

تم تعديل مايو 4 بواسطه Foksh

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

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

شكرا للاخ @Foksh على الملاحظة .

MyArchfa.accdb

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

بعد التجربة وجدت ان عملية الحفظ تأخذ وقتا حتى تظهر الرسالة اليك التعديل النهائي

وارجو المعذرة لانني كنت في العمل وعملت الكود على عجالة ولم اجربه كفايه.

MyArchfa.accdb

[العنزي العنزي]

اساتذتي الافاضل الاستاذ الفاضل Foksh والاستاذ الفاضل سامي الحداد شكرا جزيلا لكما الله لايحرمنا من شخصيكما 

نعم هذا هو المطلوب : اسأل الله جل شأنه ان يمن عليكما بالصحة والعافية والخير والبركات اللهم أمين يارب العالمين