[حل شده] بررسی وجود فایل در مسیر مشخص

[دکتر علیزاده]

سلام بر اساتید گرامی و دوستان چند تا سوال داشتم لطفا راهنمائی کنید
1- من میخواهم در درایو D یک پوشه بنام BAHAR داشته باشیم در صورت موجود نبودن با یک پیام بپرسه "میخواهید پوشه را ایجاد کنید" با تائید جواب "بلی "پوشه BAHAR ایجاد بشه
2- اگر در پوشه BAHAR فایل F100.jpg موجود بود در شیت یک سلول A1 نام F100 رو بنویسه و در A2 کلمه "موجوداست" ثبت شود در صورت موجود نبودن فایل F100.jpg - یک فایل در پوشه BAHAR ایجاد کند و در سلول A2 کلمه "فایل F100.Jpg ایجاد شد " ثبت شود.
3- فایلهای موجود در پوشه BAHAR را در یک شیت لیست شود.
سپاسگذارم دوستان

[میثم مقدم نیا]

سلام بر اساتید گرامی و دوستان چند تا سوال داشتم لطفا راهنمائی کنید
1- من میخواهم در درایو D یک پوشه بنام BAHAR داشته باشیم در صورت موجود نبودن با یک پیام بپرسه "میخواهید پوشه را ایجاد کنید" با تائید جواب "بلی "پوشه BAHAR ایجاد بشه
2- اگر در پوشه BAHAR فایل F100.jpg موجود بود در شیت یک سلول A1 نام F100 رو بنویسه و در A2 کلمه "موجوداست" ثبت شود در صورت موجود نبودن فایل F100.jpg - یک فایل در پوشه BAHAR ایجاد کند و در سلول A2 کلمه "فایل F100.Jpg ایجاد شد " ثبت شود.
3- فایلهای موجود در پوشه BAHAR را در یک شیت لیست شود.
سپاسگذارم دوستان

سلام

شرمنده بابت دیر جواب دادن این چند مددت سرم خیلی شلوغ بود

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

Sub CreateFolder()
  Dim sFolder As String
  Dim resp As VbMsgBoxResult

    sFolder = "D:\BAHAR"
  If Dir(sFolder, vbDirectory) = "" Then
    resp = MsgBox("پوشه موجود نيست. " & vbCrLf & vbCrLf & "آيا مي خواهيد پوشه را ايجاد کنيد؟", vbYesNo + vbQuestion + vbMsgBoxRight + vbMsgBoxRtlReading, "ميثم مقدم نيا")
    
If resp = vbYes Then
      MkDir sFolder
    End If
  End If
End Sub 

و اما درمورد سوال دوم شما میتوانید از کد زیر استفاده کنید

Sub CreateTxtFile()

    Dim objFSO As Object
    Dim objTS As Object
    Dim directory As String
   Dim fileName As String

    directory = "D:\BAHAR"
        If Right(directory, 1) <> "\" Then
        directory = directory & "\"
    End If

        fileName = "F100.jpg"

        Set objFSO = CreateObject("Scripting.FileSystemObject")

        'With ThisWorkbook.Worksheets("Sheet1") '    
'اگر مي خواهيد به جاي آن در برگه فعال بنويسيد، جايگزين کنيد...    

With ActiveSheet

        If objFSO.FileExists(directory & fileName) Then
            .Range("a1").Value = objFSO.GetBaseName(directory & fileName)
            .Range("a2").Value = "فايل از قبل موجود است."        
Else
            Set objTS = objFSO.CreateTextFile(directory & fileName)
            .Range("a2").Value = "فايل ايجاد شد."        
End If
    End With
     End Sub 

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

Sub This_Might_Be_Faster()
    Dim filelist() As String, i As Long, fName As String
    fName = Dir("D:\BAHAR" & "\*.*")
    While fName <> "" 
       i = i + 1
        ReDim Preserve filelist(1 To i)
        filelist(i) = fName
        fName = Dir()
    Wend
    Cells(3, 8).Resize(UBound(filelist)) = Application.Transpose(filelist)
End Sub 

امید وارم که مشکل شما حل بشه

با تشکر
میثم مقدم نیا

[دکتر علیزاده]

سلام بر استاد معظم آقای مقدم نیا
مشکل حل شد خیلی سپاسگزارم. خدا اجرتون بده