با سلام
من برنامه ای دارم که در آن یک تصویر می بایست از پوشه ای دلخواه انتخاب شده و در پوشه ای با نام تجهیز مورد نظر و بعد پوشه ای با نام تاریخ ذخیره شده و نام آن فایل نیز به تاریخ روز + تعداد فایلهای داخل پوشه تغییر کند
مشکل کار اینجاست که اگر تصویر از پوشه ای با نام فارسی انتخاب شود یا در مسیر تا پوشه نهایی ، پوشه ای با نام فارسی باشد و یا نام فایل انتخابی فارسی باشد ، فایل انتخابی انتقال پیدا نمی کند
لطفا راهنمایی فرمایید
متاسفانه چون حجم فایل بسیار زیاد است قادر به پیوست نیستم
با تشکر
من برنامه ای دارم که در آن یک تصویر می بایست از پوشه ای دلخواه انتخاب شده و در پوشه ای با نام تجهیز مورد نظر و بعد پوشه ای با نام تاریخ ذخیره شده و نام آن فایل نیز به تاریخ روز + تعداد فایلهای داخل پوشه تغییر کند
مشکل کار اینجاست که اگر تصویر از پوشه ای با نام فارسی انتخاب شود یا در مسیر تا پوشه نهایی ، پوشه ای با نام فارسی باشد و یا نام فایل انتخابی فارسی باشد ، فایل انتخابی انتقال پیدا نمی کند
لطفا راهنمایی فرمایید
متاسفانه چون حجم فایل بسیار زیاد است قادر به پیوست نیستم
با تشکر
کد:
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
کامنت