[حل شده] ایجاد و ساخت پوشه از طریق vba

[ظهور 313]

سلام و عرض ادب خدمت همه اساتید محترم

نیاز به یه فرمول دارم كه ممنون میشم اگه دوستان راهنمایی بفرمایند
در مسیر فایل اصلی، یك پوشه با یه نام مشخص، مثلا "اسناد" وجود داره، كه داخل اون، پوشههای متعددی برای شماره پروندههای مختلف هست، حالا میخوام با استفاده از یك كلید، پوشه شماره مثلا 2 باز بشه. البته اینكه كدوم شماره باز بشه، باید براساس یك تكس باكس تعیین میشه. یعنی ببینه اگر شماره تكس باكس2 مساوی بود با 8، پوشه شماره 8 رو باز كنه و البته اگر پوشه شماره 8 نبود، خودش پوشه رو بسازه و بعد بازش كنه

ممنون میشم اگر دوستان راهنمایی بفرمایند

[امين اسماعيلي]

ba drod

code zir negah mikone bebine ke folderi be name Results dar kenare file excel man hast ya na nabashe ijadesh mikone,

Sub TestForDir()
    Dim strDir As String
 strDir = ThisWorkbook.Path & "\Result\"
     
    If Dir(strDir, vbDirectory) = "" Then
        MkDir strDir
        End If
       
End Sub

hala mikhaim bebinim ke text box 2 chi mige

kafie be jaye "results" biaim benisim & textbox2.text

agram folder hato dakhele ye foldere ya jaye digas bayad adressesho be jaye ThisWorkbook.Path ba ye eslash ezafi (/) dar akhresh bezari

khob ta injash ma mibinim ke hast ya na mimone baz kardane on folder

bebine ghablan baz bode ya na, agar baze ke activesh kone nabod baz kone

'--------------------------------------------
Private Const SW_RESTORE = 9

#If VBA7 Then
    Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
    Private Declare PtrSafe Function IsIconic Lib "user32.dll" (ByVal hwnd As Long) As Long
#Else
    Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
    Private Declare Function IsIconic Lib "user32.dll" (ByVal hwnd As Long) As Long
#End If

Public Sub OpenFolder(strDirectory As String)
'DESCRIPTION: Open folder if not already open. Otherwise, activate the already opened window

Dim pID As Variant
Dim sh As Variant
On Error GoTo 102:
Set sh = CreateObject("shell.application")
For Each w In sh.Windows
    If w.Name = "Windows Explorer" Or w.Name = "File Explorer" Then
        If w.document.folder.self.Path = strDirectory Then
            'if already open, bring it front
            If CBool(IsIconic(w.hwnd)) Then ' If it's minimized, show it
                w.Visible = False
                w.Visible = True
                ShowWindow w.hwnd, SW_RESTORE
            Else
                w.Visible = False
                w.Visible = True
            End If
            Exit Sub
        End If
    End If
Next
'if you get here, the folder isn't open so open it
pID = Shell("explorer.exe " & strDirectory, vbNormalFocus)
102:
End Sub

code balaro to ye madule copy konin
va ama dar akhar taghire code aval va tarkibesh ba code bala

Private Sub CommandButton1_Click()

    Dim strDir As String
strDir = ThisWorkbook.Path & "\Result\"
    
    If Dir(strDir, vbDirectory) = "" Then
        MkDir strDir
     
Call OpenFolder(strDir)
Else
Call OpenFolder(strDir)
        End If
End Sub

[ظهور 313]

ممنونم استاد خیلی خیلی عالی و مفید
موفق و پیروز باشید