نمایش نتایج 1 تا 9 از 9

نام تاپیک: عدم انتخاب فایل در پوشه های با نام فارسی هنگام جستجو با DialogFilePicker

Hybrid View

پست قبلی پست قبلی   پست بعدی پست بعدی
  1. #1
    کاربر جدید آواتار ZAMEN58
    تاریخ عضویت
    اسفند 1396
    محل زندگی
    دهاقان
    پست
    9

    عدم انتخاب فایل در پوشه های با نام فارسی هنگام جستجو با DialogFilePicker

    با سلام
    من برنامه ای دارم که در آن یک تصویر می بایست از پوشه ای دلخواه انتخاب شده و در پوشه ای با نام تجهیز مورد نظر و بعد پوشه ای با نام تاریخ ذخیره شده و نام آن فایل نیز به تاریخ روز + تعداد فایلهای داخل پوشه تغییر کند
    مشکل کار اینجاست که اگر تصویر از پوشه ای با نام فارسی انتخاب شود یا در مسیر تا پوشه نهایی ، پوشه ای با نام فارسی باشد و یا نام فایل انتخابی فارسی باشد ، فایل انتخابی انتقال پیدا نمی کند
    لطفا راهنمایی فرمایید
    متاسفانه چون حجم فایل بسیار زیاد است قادر به پیوست نیستم
    با تشکر


    Dim FSO As Object
    Dim I As Integer
    Dim SplitDir() As String
    Dim CreateDir As String
    Dim strDirectoryPath, strPicturePath, strOldDirectoryPath, strNewDirectoryPath, strOldFileName, strNewFileName, strOldFileType, strNewFileDir, strNodeID, strItemName As String
    Dim strFileCount As Integer
    ItemName1 = ItemName
    NodeID1 = NodeID
    InsertDate1 = InsertDate
    Me.DirectoryPath1 = DirectoryPath
    Forms!frmInsertPicture.Cycle = 0
    DoCmd.GoToRecord , , acNewRec
    DirectoryPath = DirectoryPath1
    ItemName = ItemName1
    NodeID = NodeID1
    InsertDate = InsertDate1
    DirectoryPath1 = DirectoryPath
    strDirectoryPath = DirectoryPath & "\Picture" & InsertDate & ""
    strPicturePath = CurrentProject.Path & "\Picture" & InsertDate & ""
    If IsNull(strDirectoryPath) Or strDirectoryPath = "\Picture" & InsertDate & "" Then
    strDirectoryPath = strPicturePath
    End If
    SplitDir = Split(strDirectoryPath, "")
    Set FSO = CreateObject("Scripting.FileSystemObject")
    I = 0
    For I = LBound(SplitDir()) To UBound(SplitDir())
    If I = 0 Then
    CreateDir = SplitDir(I)
    Else
    CreateDir = CreateDir & "" & SplitDir(I)
    End If
    If FSO.FolderExists(CreateDir) = False Then
    FSO.CreateFolder (CreateDir)
    End If
    Next I
    With Application.FileDialog(msoFileDialogFilePicker)
    .InitialFileName = strPicturePath
    .InitialView = msoFileDialogViewLargeIcons
    .Filters.Clear
    .Filters.add "jpeg", "*.jpg"
    .Filters.add "bitmap", "*.bmp"
    .Filters.add "tiff", "*.tif"
    .Filters.add "GIF", "*.gif"
    .Filters.add "PNG", ".png"
    .Filters.add "All Files", "*.*"
    .FilterIndex = 1
    .AllowMultiSelect = False
    .Title = "ÇäÊÎÇÈ ÝÇíá ÊÕæíÑ"
    If .Show = -1 Then
    strOldDirectoryPath = .SelectedItems(1)
    strOldFileName = Dir(.SelectedItems(1))
    strOldFileType = Right(strOldFileName, 3)
    strNewDirectoryPath = strDirectoryPath
    strNewFileDir = Dir(strNewDirectoryPath & "*." & strOldFileType)
    Do While strNewFileDir <> ""
    strFileCount = strFileCount + 1
    strNewFileDir = Dir()
    Loop
    strNewFileName = InsertDate & "(" & strFileCount + 1 & ")." & strOldFileType
    Name strOldDirectoryPath As strNewDirectoryPath & strNewFileName
    PictureFolderPath = strNewDirectoryPath
    CopyMoveTick = 1
    End If
    End With
    Forms!frmInsertPicture.Cycle = 1
    Debug.Print strOldDirectoryPath
    Debug.Print strOldFileName
    Debug.Print strNewDirectoryPath
    End Function

  2. #2
    کاربر دائمی آواتار Mehr@ban
    تاریخ عضویت
    آبان 1389
    محل زندگی
    بچه محله امام رضا
    پست
    562

    نقل قول: عدم انتخاب فایل در پوشه های با نام فارسی هنگام جستجو با DialogFilePicker

    سلام

    مسیر زیر رو یه بررسی کنید
    http://access-training.blog.ir/post/...8%AF%D8%B1-VBA

    اگر براتون مقدوره بخشی از برنامه که مشکل داره رو قرار بدین تا بشه فهمید اشکال از کجاست

  3. #3
    کاربر جدید آواتار ZAMEN58
    تاریخ عضویت
    اسفند 1396
    محل زندگی
    دهاقان
    پست
    9

    نقل قول: عدم انتخاب فایل در پوشه های با نام فارسی هنگام جستجو با DialogFilePicker

    سلام ممنون
    این هم فایل پیوست
    1.rar

  4. #4
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    نقل قول: عدم انتخاب فایل در پوشه های با نام فارسی هنگام جستجو با DialogFilePicker

    نه file system object و نه folder dialog هیچکدوم مشکلی با اسامی فارسی یا چند تکه ندارن.
    جای دیگه دنبال مشکل بگردین.

  5. #5
    کاربر جدید آواتار ZAMEN58
    تاریخ عضویت
    اسفند 1396
    محل زندگی
    دهاقان
    پست
    9

    نقل قول: عدم انتخاب فایل در پوشه های با نام فارسی هنگام جستجو با DialogFilePicker

    سلام نمی دونم چیه ولی همین قدر می دونم روی سیستم محل کارم به یه پوشه فارسی ایراد نمی گیره ولی اگه دوتا پشت سر هم شد فایل را جابجا نمی کنه ولی روی کامپیوتر خونه به یه دونه هم ایراد میگیره
    راستی شما بعد از وارد کردن تصاویر توی فرم جستجو هم رفتید ؟
    آیا تصویر توی پوشه رفته بود؟
    این را به این خاطر می گم که پوشه ها را ایجاد میکنه ولی تصویر انتقال پیدا نمی کنه
    ممنون

  6. #6
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    نقل قول: عدم انتخاب فایل در پوشه های با نام فارسی هنگام جستجو با DialogFilePicker

    برنامه پیوست رو یک نگاه انداختم،
    فقط باید بخشی رو که مشکل داره اون هم ساده شده قرار بدین

    تنها راهش اینه که برنامه تون رو دیباگ کنین.

  7. #7
    کاربر جدید آواتار ZAMEN58
    تاریخ عضویت
    اسفند 1396
    محل زندگی
    دهاقان
    پست
    9

    نقل قول: عدم انتخاب فایل در پوشه های با نام فارسی هنگام جستجو با DialogFilePicker

    نقل قول نوشته شده توسط mazoolagh مشاهده تاپیک
    برنامه پیوست رو یک نگاه انداختم،
    فقط باید بخشی رو که مشکل داره اون هم ساده شده قرار بدین

    تنها راهش اینه که برنامه تون رو دیباگ کنین.
    سلام
    من فقط توی همین قسمت مشکل دارم
    منظورتون از ساده شده چیه؟
    من 90 درصد برنامه اصلی رو حذف کردم

  8. #8
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    نقل قول: عدم انتخاب فایل در پوشه های با نام فارسی هنگام جستجو با DialogFilePicker

    ساده شده یعنی فقط و فقط مشکل بدون هر ابجکت اضافی دیگه
    اینجوری باید صبر کنین یک نفر بیکار پیدا بشه وقت آزاد داشته باشه

    دیباگ کنین (trace) ، سریع مشکل پیدا میشه

  9. #9
    کاربر جدید آواتار ZAMEN58
    تاریخ عضویت
    اسفند 1396
    محل زندگی
    دهاقان
    پست
    9

    نقل قول: عدم انتخاب فایل در پوشه های با نام فارسی هنگام جستجو با DialogFilePicker

    سلام آقای پرکار
    از یه طریق دیگه رفتم حل شد

    Private Sub cmdInsertPicture_Click()
    If InsertDate = 0 Then Exit Sub
    If IsNull(NodeID) Or NodeID = "0" Then Exit Sub
    On Error Resume Next
    Dim FSO As Object
    Dim A, B, c As Integer, lngLenSourcePath As Long, lngTargetFilesCount1 As Long, lngTargetFilesCount2 As Long, lngLenSourceFileName, lngInsertDate As Long
    Dim SplitDir() As String, CreateDir As String, strPictureFolder As String, strSourcePath As String, strTempPath As String, TmpFileName As String
    Dim strSourceFileName As String, strTargetFileName As String, strFileType As String, strTargetPath As String, PathAsciiCode As Variant
    '================================================= ================================================== ================================================== ========
    strTargetPath = SelDirectoryPath & Chr(92) & Chr(202) & Chr(213) & Chr(199) & Chr(230) & Chr(237) & Chr(209) & Chr(92) & InsertDate & Chr(92)
    '================================================= ================================================== ===============================================
    strPictureFolder = CurrentProject.Path & Chr(92) & Chr(202) & Chr(213) & Chr(199) & Chr(230) & Chr(237) & Chr(209) & Chr(92) & InsertDate & Chr(92)
    '================================================= ================================================== ===============================================
    If IsNull(strTargetPath) Or IsNull(NodeID) Or NodeID = "0" Then
    strTargetPath = strPictureFolder
    End If
    '================================================= ==
    Set FSO = CreateObject("Scripting.FileSystemObject")
    SplitDir = Split(strTargetPath, "")
    A = 0
    For A = LBound(SplitDir()) To UBound(SplitDir())
    If A = 0 Then
    CreateDir = SplitDir(A)
    Else
    CreateDir = CreateDir & Chr(92) & SplitDir(A)
    End If
    If FSO.FolderExists(CreateDir) = False Then
    FSO.CreateFolder (CreateDir)
    End If
    Next A
    lngInsertDate = InsertDate
    Forms!frmInsertPicture.Cycle = 0
    DoCmd.GoToRecord , , acNewRec
    Forms!frmInsertPicture.Cycle = 1
    NodeID = SelNodeID
    ItemName = SelItemName
    InsertDate = lngInsertDate
    With Application.FileDialog(msoFileDialogFilePicker)
    '================================================= ==
    .InitialFileName = CurrentProject.Path
    .InitialView = msoFileDialogViewLargeIcons
    .Filters.Clear
    .Filters.Add "jpeg", "*.jpg"
    .Filters.Add "bitmap", "*.bmp"
    .Filters.Add "tiff", "*.tif"
    .Filters.Add "GIF", "*.gif"
    .Filters.Add "PNG", ".png"
    .Filters.Add "All Files", "*.*"
    .FilterIndex = 1
    .AllowMultiSelect = False
    .Title = Chr(199) & Chr(228) & Chr(202) & Chr(206) & Chr(199) & Chr(200) & Chr(32) & Chr(221) _
    & Chr(199) & Chr(237) & Chr(225) & Chr(32) & Chr(202) & Chr(213) & Chr(230) & Chr(237) & Chr(209)
    '================================================= ================================================
    If .Show = -1 Then
    strSourcePath = .SelectedItems(1)
    '=========================================
    lngLenSourcePath = Len(strSourcePath)
    PathAsciiCode = ""
    For B = 1 To lngLenSourcePath
    PathAsciiCode = PathAsciiCode & "&Chrw(" & Asc(Mid(strSourcePath, B, 1)) & ")"
    Next B
    strSourcePath = Right(PathAsciiCode, Len(PathAsciiCode) - 1).Value
    '================================================= ==============================================
    SplitDir = Split(strSourcePath, "")
    strSourceFileName = SplitDir(UBound(SplitDir()))
    lngLenSourceFileName = Len(strSourceFileName)
    SplitDir = Split(strSourcePath, ".")
    strFileType = SplitDir(UBound(SplitDir()))
    '=============================================
    lngLenSourcePath = Len(strTargetPath)
    PathAsciiCode = ""
    For A = 1 To lngLenSourcePath
    PathAsciiCode = PathAsciiCode & "&Chrw(" & Asc(Mid(strTargetPath, A, 1)) & ")"
    Next A
    strTargetPath = Right(PathAsciiCode, Len(PathAsciiCode) - 1).Value
    '================================================= ==============================================
    If FSO.FolderExists(strTargetPath) Then
    lngTargetFilesCount1 = FSO.GetFolder(strTargetPath).Files.Count
    End If
    SplitDir = Split(CurrentProject.Path, "")
    strTempPath = SplitDir(0) & "" & InsertDate & "(" & lngTargetFilesCount1 + 1 & ")." & strFileType
    FSO.MoveFile Source:=strSourceFileName, Destination:=strTempPath
    FSO.MoveFile Source:=strTempPath, Destination:=strTargetPath
    '=============================================
    If FSO.FolderExists(strTargetPath) Then
    lngTargetFilesCount2 = FSO.GetFolder(strTargetPath).Files.Count
    End If
    '=============================================
    If lngTargetFilesCount2 = lngTargetFilesCount1 + 1 Then
    PictureFolderPath = strTargetPath
    Me.CopyMoveTick = 1
    Else
    MsgBox (Chr(202) & Chr(213) & Chr(230) & Chr(237) & Chr(209) & Chr(32) & Chr(227) & Chr(228) & Chr(202) & Chr(222) & Chr(225) & Chr(32) _
    & Chr(228) & Chr(212) & Chr(207) & vbNewLine & Chr(58) & Chr(227) & Chr(211) & Chr(237) & Chr(209) & Chr(32) & Chr(230) & Chr(32) & Chr(228) _
    & Chr(199) & Chr(227) & Chr(32) & Chr(221) & Chr(199) & Chr(237) & Chr(225) & Chr(32) & Chr(199) & Chr(228) & Chr(202) & Chr(206) & Chr(199) _
    & Chr(200) & Chr(237) & Chr(32) & vbNewLine & strTempPath)
    End If
    End If
    End With
    End Sub

تاپیک های مشابه

  1. سوال: جلوگیری از دسترسی کاربران به برخی پوشه ها
    نوشته شده توسط mojtaba-n در بخش ASP.NET Web Forms
    پاسخ: 7
    آخرین پست: پنج شنبه 18 دی 1393, 22:47 عصر
  2. پاسخ: 2
    آخرین پست: دوشنبه 26 فروردین 1392, 14:10 عصر
  3. سوال: سطح دسترسی به فایل ها یک پوشه
    نوشته شده توسط mrdchmrdch در بخش ASP.NET Web Forms
    پاسخ: 1
    آخرین پست: سه شنبه 15 اسفند 1391, 02:35 صبح
  4. حرفه ای: جستجوی فایل در تمام پوشه ها و زیر پوشه ها (فولدر دارای حرف ی فارسی )
    نوشته شده توسط shinyboy در بخش برنامه نویسی در 6 VB
    پاسخ: 2
    آخرین پست: چهارشنبه 01 آذر 1391, 18:03 عصر
  5. پاسخ: 2
    آخرین پست: چهارشنبه 06 مهر 1390, 11:14 صبح

برچسب های این تاپیک

قوانین ایجاد تاپیک در تالار

  • شما نمی توانید تاپیک جدید ایجاد کنید
  • شما نمی توانید به تاپیک ها پاسخ دهید
  • شما نمی توانید ضمیمه ارسال کنید
  • شما نمی توانید پاسخ هایتان را ویرایش کنید
  •