01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 | Sub CreateFoldersFromSelectionWithDialog() Dim selectedRange As Range Dim cell As Range Dim folderPath As String Dim folderName As String Dim dialog As FileDialog ' เปิดหน้าต่างเลือกโฟลเดอร์ Set dialog = Application.FileDialog(msoFileDialogFolderPicker) dialog.Title = "เลือกโฟลเดอร์ที่ต้องการวางโฟลเดอร์ย่อย" ' หากผู้ใช้กดตกลง ให้บันทึกเส้นทางโฟลเดอร์ If dialog.Show = -1 Then folderPath = dialog.SelectedItems(1) & "\" Else MsgBox "ไม่ได้เลือกโฟลเดอร์!" , vbExclamation Exit Sub End If ' ตรวจสอบว่ามีการเลือกช่วงเซลล์หรือไม่ If TypeName(Selection) <> "Range" Then MsgBox "โปรดเลือกเซลล์ที่ต้องการก่อน!" , vbExclamation Exit Sub End If ' กำหนดช่วงเซลล์ที่เลือก Set selectedRange = Selection ' ลูปสร้างโฟลเดอร์ตามค่าที่อยู่ในเซลล์ที่เลือก For Each cell In selectedRange folderName = cell.Value If folderName <> "" Then On Error Resume Next ' ข้ามกรณีที่โฟลเดอร์มีอยู่แล้ว MkDir folderPath & folderName On Error GoTo 0 End If Next cell MsgBox "สร้างโฟลเดอร์ตามเซลล์ที่เลือกเรียบร้อยแล้วใน: " & folderPath, vbInformation End Sub |