تحديد مسار حفظ المرفقات

[eng aoff]

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

Dim path_folder_attaced As String

If IsNull([id]) Or IsNull([number]) Or IsNull([data]) Or IsNull(name_Arc) Or IsNull([name_Arc]) Then

Dim my_msg As String

    my_msg = MsgBox("لن يتم إرفاق اى ملفات لعدم إكتمال كل البيانات" & vbCrLf & _

    "-  رقم الكتاب" & vbCrLf & _

    "- تاريخ الكتاب" & vbCrLf & _

    "-موضوع الكتاب", _

    vbOKOnly, _

    "خطـــــأ")

 

'Call add_id_new_rec

 

Else

path_folder_attaced = db_path() & "مرفقات" & "مرفقات ادارة\" & "\صادر ادارة\" & [id] & "\"

If Dir(path_folder_attaced, vbDirectory) = "" Then

MkDir path_folder_attaced

End If

 

Me.pate = path_folder_attaced

On Error GoTo err_cmd_Open_desktob_Click

    Dim strFileNames As Variant

    Dim strFilter

    Dim sFolder

    Dim SelectedFiles

    

    strFilter = "All Files " & _

             "(*.*)" & vbNullChar & _

              "*.*" & vbNullChar & vbNullChar

    sFolder = "C:\"

    

    ' call the API for the Multi File Dialog

    strFileNames = apiBrowseFiles("Select a File, OR Multiple Files", sFolder, , strFilter)

    

    ' user didn't select any file, s/he proceed cancel

    If UBound(strFileNames) = 0 Then

        Exit Sub

    End If

    

    SelectedFiles = UBound(strFileNames) ' number of selected files

        

    ' take the 1st file name and extract the Folder name from it

    ' Don't Dim sFolder, it has been declared as Global variable

    ' so that the last folder visited will be opened again

    sFolder = strFileNames(1)

    Do While Right(sFolder, 1) <> "\"

      sFolder = Left(sFolder, Len(sFolder) - 1)

    Loop

    sFolder = Replace(sFolder, "\\", "\")

    Dim rc

    Dim i

    

    Set rst = Me.frm_Sub_attachmentssede.Form.RecordsetClone

    rst.MoveLast: rst.MoveFirst

    rc = rst.RecordCount

    

    

    ' Add the selected items, and seperate them by a ; so that we use it as Row Source for

    ' list the files selected in the Listbox lstMultipleFiles

    For i = 1 To UBound(strFileNames)

        

        Dim File_Path_Name

        Dim FileExt

        Dim File_Name

        Dim New_File

        

        File_Path_Name = Replace(strFileNames(i), "\\", "\")

        FileExt = mID(strFileNames(i), InStrRev(strFileNames(i), ".") + 1)

        FileExt = IIf(FileExt = File_Path_Name, "", FileExt) 'file has No Extension

        File_Name = Replace(File_Path_Name, sFolder, "")

        New_File = "image" & Me.id & "_" & i + rc & "." & FileExt

        

        ' Copy the original file to Folder in the main Form

        FileCopy File_Path_Name, Me.pate & "\" & New_File

    

                rst.AddNew

                    rst!name_morfke = New_File

                    rst!tayp = FileExt

                    

                    rst!emp_id = Me.id

                rst.Update

    Next i

Exit_cmd_Open_desktob_Click:

Exit Sub

err_cmd_Open_desktob_Click:

    If err.number = 3021 Then

        rc = 0

        Resume Next

    Else

        MsgBox err.number & vbCrLf & err.Description

    End If

End If

[eng aoff]

ياريت المساعدة 

[jjafferr]

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

 

اللي فهمته من طلبك هو:

انك تريد تفتح نافذة الوندوز ، وتجيك قائمة بأسماء مجلدات الكمبيوتر والشبكة ،

لذا افتح الرابط

 

 

وبتلاقي في الكود هذا السطر:

strFolderName = BrowseFolder(strMsg)

.

وهو ينادي وحدة نمطية لفتح النافذة التالية:

.

جعفر