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


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