¡ÚVBA¡Û¥Õ¥¡¥¤¥ë°ìÍ÷¤ò¥·¡¼¥È¤Ëɽ¼¨¤¹¤ë
¡ãµ¡Ç½¡ä
¡Ê£±¡Ë¥Õ¥¡¥¤¥ë°ìÍ÷(¥µ¥Ö¥Õ¥©¥ë¥À¤ò´Þ¤à)¤ò¼èÆÀ¤·¤Æ¥·¡¼¥È¤Ëɽ¼¨¤·¤Þ¤¹
¡Ê£²¡Ë¥µ¥Ö¥Õ¥©¥ë¥À¤ÏºÆµ¢Åª¤ËÆɤ߹þ¤ß¤Þ¤¹
¡ã¥¤¥á¡¼¥¸¡ä
¡ã»È¤¤Êý¡ä
°ìÈÖ´Êñ¤Ê¤Î¤ÏThisWorkbook¤Ë¤½¤Î¤Þ¤ÞÄ¥¤êÉÕ¤±¤Æ¤¯¤À¤µ¤¤
¿§¡¹¥¢¥ì¥ó¥¸¤·¤Æ¤âÌÌÇò¤¤¤È»×¤¤¤Þ¤¹
'//¥ï¡¼¥¯¥Ö¥Ã¥¯¥ª¡¼¥×¥ó¤Ç¥Õ¥©¥ë¥ÀÁªÂò¥À¥¤¥¢¥í¥°¤òɽ¼¨
Private Sub Workbook_Open()
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
¥Õ¥¡¥¤¥ë°ìÍ÷ .SelectedItems(1)
End If
End With
End Sub
Private Sub Workbook_Open()
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
¥Õ¥¡¥¤¥ë°ìÍ÷ .SelectedItems(1)
End If
End With
End Sub
'//ÁªÂò¤µ¤ì¤¿¥Õ¥©¥ë¥À¤Î¥Õ¥¡¥¤¥ë°ìÍ÷¤ò¼èÆÀ¤¹¤ë¥×¥í¥·¡¼¥¸¥ã¤ò¥³¡¼¥ë
Sub ¥Õ¥¡¥¤¥ë°ìÍ÷(ByVal folpath As String)
'Á´¤Æ(¿ô¼°¡¢Ê¸»úÎó¡¢½ñ¼°¡¢¥³¥á¥ó¥È¡¢¥¢¥¦¥È¥é¥¤¥ó)¥¯¥ê¥¢
Cells.Select
Selection.Clear
'Îó¤ÎÉý¡¢¥Õ¥©¥ó¥È¥µ¥¤¥º¤ò¥»¥Ã¥È
Selection.ColumnWidth = 4
Selection.Font.Size = 9
Range("A1").Select
Sub ¥Õ¥¡¥¤¥ë°ìÍ÷(ByVal folpath As String)
'Á´¤Æ(¿ô¼°¡¢Ê¸»úÎó¡¢½ñ¼°¡¢¥³¥á¥ó¥È¡¢¥¢¥¦¥È¥é¥¤¥ó)¥¯¥ê¥¢
Cells.Select
Selection.Clear
'Îó¤ÎÉý¡¢¥Õ¥©¥ó¥È¥µ¥¤¥º¤ò¥»¥Ã¥È
Selection.ColumnWidth = 4
Selection.Font.Size = 9
Range("A1").Select
'¥Õ¥¡¥¤¥ë°ìÍ÷¤ò¥µ¥Ö¥Õ¥©¥ë¥À¤Þ¤Ç¼èÆÀ¤·¤Æɽ¼¨¤¹¤ë
Application.ScreenUpdating = False
Call ¥Õ¥¡¥¤¥ë°ìÍ÷¤ò¼èÆÀ(folpath, 1, 0)
Application.ScreenUpdating = True
Application.ScreenUpdating = False
Call ¥Õ¥¡¥¤¥ë°ìÍ÷¤ò¼èÆÀ(folpath, 1, 0)
Application.ScreenUpdating = True
'½ªÎ»¥á¥Ã¥»¡¼¥¸
MsgBox "¤ª¤ï¤ê¤Þ¤·¤¿", vbInformation
End Sub
MsgBox "¤ª¤ï¤ê¤Þ¤·¤¿", vbInformation
End Sub
'//¥Õ¥¡¥¤¥ë°ìÍ÷¤òºÆµ¢Åª¤Ë¼èÆÀ¤·¤Æ¥·¡¼¥È¤Ëɽ¼¨¤¹¤ë
'//°ú¿ô¡¡gyo¡§½ÐÎϳ«»Ï¹ÔÈÖ¹æ
'//¡¡¡¡¡¡clm¡§½ÐÎϳ«»ÏÎóÈÖ¹æ(1ÎóÌܤ«¤é¤ÎÁêÂÐÃÍ)
Sub ¥Õ¥¡¥¤¥ë°ìÍ÷¤ò¼èÆÀ(ByVal folpath As String, ByRef gyo As Long, ByVal clm As Integer)
Dim buf As String
Dim fol As Object
'//°ú¿ô¡¡gyo¡§½ÐÎϳ«»Ï¹ÔÈÖ¹æ
'//¡¡¡¡¡¡clm¡§½ÐÎϳ«»ÏÎóÈÖ¹æ(1ÎóÌܤ«¤é¤ÎÁêÂÐÃÍ)
Sub ¥Õ¥¡¥¤¥ë°ìÍ÷¤ò¼èÆÀ(ByVal folpath As String, ByRef gyo As Long, ByVal clm As Integer)
Dim buf As String
Dim fol As Object
'¥ë¡¼¥È¥Õ¥©¥ë¥À¤òɽ¼¨
Cells(gyo, 1) = "¡Ú" & CStr(gyo) & "¡Û"
Cells(gyo, 2 + clm) = folpath
gyo = gyo + 1
Cells(gyo, 1) = "¡Ú" & CStr(gyo) & "¡Û"
Cells(gyo, 2 + clm) = folpath
gyo = gyo + 1
'¥Õ¥¡¥¤¥ë°ìÍ÷¤ò¼èÆÀ
buf = Dir(folpath & "¥*.*", vbNormal)
Do While buf <> ""
Cells(gyo, 1) = "¡Ú" & CStr(gyo) & "¡Û"
Cells(gyo, 2 + clm) = "ø"
Cells(gyo, 2 + clm + 1) = buf
gyo = gyo + 1
buf = Dir()
Loop
buf = Dir(folpath & "¥*.*", vbNormal)
Do While buf <> ""
Cells(gyo, 1) = "¡Ú" & CStr(gyo) & "¡Û"
Cells(gyo, 2 + clm) = "ø"
Cells(gyo, 2 + clm + 1) = buf
gyo = gyo + 1
buf = Dir()
Loop
'¥µ¥Ö¥Õ¥©¥ë¥À¤«¤é¥Õ¥¡¥¤¥ë°ìÍ÷¤ò¼èÆÀ
With CreateObject("Scripting.FileSystemObject")
For Each fol In .getFolder(folpath).SubFolders
Call ¥Õ¥¡¥¤¥ë°ìÍ÷¤ò¼èÆÀ(fol.Path, gyo, clm + 1)
Next fol
End With
End Sub
With CreateObject("Scripting.FileSystemObject")
For Each fol In .getFolder(folpath).SubFolders
Call ¥Õ¥¡¥¤¥ë°ìÍ÷¤ò¼èÆÀ(fol.Path, gyo, clm + 1)
Next fol
End With
End Sub
¤è¤í¤·¤±¤ì¤Ð¥Ý¥Á¥Ã¤È²¡¤·¤Æ¤¯¤À¤µ¤¤
- 2015.11.03 Tuesday
- VBA
- 12:41
- -
- -
- by ¤¦¡¼¤Á¤ã¤ó