[حل شده] فراخوانی فایل از فولدر

[younes672]

باسلام و عرض ادب
دوستان در کدهای زیر فقط فایل jpg از فولدر فراخوانی می شود. چطور میشه فایل pdf وdocx را اضافه کرد

Private Sub CommandButton1_Click()
'Dim img As Variant
'
'img = Application.GetOpenFilename("Excel File (*.jpg),*.jpg", 1, "Excel", 1, False)
'On Error GoTo Err_img
'
'Image1.Picture = LoadPicture(img)
'
'Err_img:
'Exit Sub
Dim cou As Integer
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
cou = Application.FileDialog(msoFileDialogOpen).Show
If cou <> 0 Then
    strPatch = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
    Image1.Picture = LoadPicture(strPatch)
    Image1.PictureSizeMode = 1
End If

End Sub

[younes672]

دوستان راهنمایی بفرمایید
هدف انتخاب یک فایل از فولدر 1 و تغییر نام (نام جدید در تکست باکس1)و انتقال به فولدر 2 می باشد. (نوع فایل ها pdf , jpg)

[iranweld]

دوستان راهنمایی بفرمایید
هدف انتخاب یک فایل از فولدر 1 و تغییر نام (نام جدید در تکست باکس1)و انتقال به فولدر 2 می باشد. (نوع فایل ها pdf , jpg)

در کدهای شما فایلی که بصورت عکس باشد نمایش داده میشود

  Image1.Picture = LoadPicture(strPatch)
    Image1.PictureSizeMode = 1 

[younes672]

در کدهای شما فایلی که بصورت عکس باشد نمایش داده میشود

  Image1.Picture = LoadPicture(strPatch)
    Image1.PictureSizeMode = 1 

بله درست می فرمایید باید این کدها تغییر کنن.

[iranweld]

با سلام

فایل پیوست را بررسی کنید

Public Function RenameFileOrDir(ByVal strSource As String, ByVal strTarget As String, _
  Optional fOverwriteTarget As Boolean = False) As Boolean
 
  On Error GoTo PROC_ERR
 
  Dim fRenameOK As Boolean
  Dim fRemoveTarget As Boolean
  Dim strFirstDrive As String
  Dim strSecondDrive As String
  Dim fOK As Boolean
 
  If Not ((Len(strSource) = 0) Or (Len(strTarget) = 0) Or (Not (FileOrDirExists(strSource)))) Then
 
    ' Check if the target exists
    If FileOrDirExists(strTarget) Then
 
      If fOverwriteTarget Then
        fRemoveTarget = True
      Else
        If MsgBox("Do you wish to overwrite the target file?", vbExclamation + vbYesNo, "Overwrite confirmation") = vbYes Then
          fRemoveTarget = True
        End If
      End If
 
      If fRemoveTarget Then
        ' Check that it's not a directory
        If ((GetAttr(strTarget) And vbDirectory)) <> vbDirectory Then
          Kill strTarget
          fRenameOK = True
        Else
          MsgBox "Cannot overwrite a directory", vbOKOnly, "Cannot perform operation"
        End If
      End If
    Else
      ' The target does not exist
      ' Check if source is a directory
      If ((GetAttr(strSource) And vbDirectory) = vbDirectory) Then
        ' Source is a directory, see if drives are the same
        strFirstDrive = Left(strSource, InStr(strSource, ":\"))
        strSecondDrive = Left(strTarget, InStr(strTarget, ":\"))
        If strFirstDrive = strSecondDrive Then
          fRenameOK = True
        Else
          MsgBox "Cannot rename directories across drives", vbOKOnly, "Cannot perform operation"
        End If
      Else
        ' It's a file, ok to proceed
        fRenameOK = True
      End If
    End If
 
    If fRenameOK Then
      Name strSource As strTarget
      fOK = True
    End If
  End If
 
  RenameFileOrDir = fOK
 
PROC_EXIT:
  Exit Function
 
PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , "RenameFileOrDir"
  Resume PROC_EXIT
End Function

Public Function FileOrDirExists(strDest As String) As Boolean
  Dim intLen As Integer
  Dim fReturn As Boolean

  fReturn = False

  If strDest <> vbNullString Then
    On Error Resume Next
    intLen = Len(Dir$(strDest, vbDirectory + vbNormal))
    On Error GoTo PROC_ERR
    fReturn = (Not Err And intLen > 0)
  End If

PROC_EXIT:
  FileOrDirExists = fReturn
  Exit Function

PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , "FileOrDirExists"
  Resume PROC_EXIT
End Function 

[younes672]

خیلی عالی بود
فقط فایل باید از فولدر اول در فولدر دیگری انتقال داده شود.

[iranweld]

خیلی عالی بود
فقط فایل باید از فولدر اول در فولدر دیگری انتقال داده شود.

آیا تست کردید که جواب نداد ؟

[younes672]

اگه امکان داره در تکست باکس دوم فقط اسم فایل (مثلpdf .02 ) ثبت بشه. مسیر فولدر 2 در کدها قرار بگیره. سپاسگزارم

[iranweld]

اگه امکان داره در تکست باکس دوم فقط اسم فایل (مثلpdf .02 ) ثبت بشه. مسیر فولدر 2 در کدها قرار بگیره. سپاسگزارم

کد ذیل را جایگزین کنید

Private Sub CommandButton2_Click()

If TextBox2 <> "" Then
  
  For i = Len(TextBox1) To 1 Step -1
  
  If Mid(TextBox1, i, 1) = "\" Then
    
  Exit For
  
  End If
  
  Next
  
  If i > 0 Then
  
  kk = Left(TextBox1, i)
  
  yy = kk & TextBox2
   
  
  fOK = RenameFileOrDir(TextBox1, yy)
  
  TextBox1 = ""
  
  TextBox2 = ""

  End If
  
 End If
  
End Sub 

[younes672]

دوست عزیز تشکر از پیگری ها و راهنمایی که فرمودید
کپی کردم ولی نتونستم اجرا کنم لطفا فایل اکسل را پیوست کنید.

[iranweld]

در فایل پیوست فقط نام فایل را بدون پسوند و مسیر فایل وارد کنید