Skills/Excel VBA

폴더 내 파일 리스트, 파일명 변경 (rename)

섬그늘 2012. 3. 16. 22:38

아래 파일의 전반부는 폴더명을 주면 그 폴더 내 파일명을 리스트하는 프로그램으로, '파일명 변경'으로 검색한 넷에서 가져 옴. 후반부는 입맛대로 조건을 주어 파일명을 바꾸는 연습이며 VBA에서 파일 rename은

 

Name AAA as BBB

 

의 문법을 따름. (AAA든 BBB든 파일path를 포함하는 문자열)

----------------------------------

Sub DirFileList()

Dim fileList() As String
Dim fName As String
Dim fPath As String
Dim i As Integer
Dim j, k, l As Integer
Dim startrow As Integer
Dim ws As Worksheet
Dim filetype  As String
Dim hd, hd1, hd2, md(2) As String

'셀에 항목으로 경로입력이 필요함을 통보
Range("C2").Select
fPath = "D:\download\West Wing (웨스트 윙) - 7시즌\"
'셀에 항목으로 확장자입력이 필요함을 통보
filetype = "*"

hd1 = "The.West.Wing": j = Len(hd1)
hd2 = "The West Wing"
md(0) = ".ac3": md(1) = ".AC3": md(2) = "(DVDR"

startrow = 2    'starting row for the data
fName = Dir(fPath & "*." & filetype)

While fName <> ""
    i = i + 1
    ReDim Preserve fileList(1 To i)
    fileList(i) = fName
    fName = Dir()
Wend


If i = 0 Then
Range("F2").Select
    ActiveCell.FormulaR1C1 = "No Files Found!"
    Exit Sub
End If
For i = 1 To UBound(fileList)
'    ws.Range("A" & i + startrow).Value = fileList(i)
    Range("A" & i + startrow).Value = fileList(i)
    fName = fileList(i)
    hd = Left(fileList(i), j)
   
    If hd = hd1 Or hd = hd2 Then
        fileList(i) = "WW" + Mid(fileList(i), j + 1, Len(fileList(i)) - j)
    End If
   
    l = 0
    For k = 0 To 2
        If l = 0 Then l = InStr(1, fileList(i), md(k))
    Next
   
    If l > 0 Then
        fileList(i) = Left(fileList(i), l - 1) + Right(fileList(i), 4)
    End If
   
    l = InStr(1, fileList(i), " - ")
    If l > 0 Then
        fileList(i) = Left(fileList(i), l - 1) + "." + Right(fileList(i), Len(fileList(i)) - l - 2)
    End If
   
    l = InStr(1, fileList(i), "WW.S0")
    If l = 1 Then
        fileList(i) = "WW." + Mid(fileList(i), 6, 1) + "x" + Mid(fileList(i), 8, 2) + Right(fileList(i), Len(fileList(i)) - 9)
    End If
   
    Range("B" & i + startrow).Value = fileList(i)
    If fName <> fileList(i) Then
        Name fPath + fName As fPath + fileList(i)
    End If
   
Next

Columns(1).AutoFit
Columns(2).AutoFit

 

End Sub


--------------------------------------(끝)