티스토리 뷰
GoPro 영상 저장시 파일명 저장 형태가 특이하여 시간기준으로 바꾸어 쉽게 정렬하기 위한 매크로입니다.
고프로는 Full HD 기준 약 11분 정도의 4G정도씩 파일을 분할하여 저장하는데
GH0100001.mp4 다음에 GH0200001.mp4가 되고 그 다음 새로 찍은 파일은 GH0100002.mp4 다음에 GH0200002.mp4가 되어 버립니다.
문제는 이렇게 되면 일반적인 파일명 순서가 아니기 때문에
윈도우에서 파일명 순으로 정렬해보면 동영상의 순서가 뒤죽박죽이 되어 버립니다.
이러한 난관을 극복하고자 Advanced Renamer 같은 프로그램을 많이 쓰는데
이정도는 Excel VBA로도 가능합니다.
지난 파일명 일괄 변경 엑셀 VBA를 수정하여 일괄 변경 매크로를 만들어보았습니다.
mp4파일의 촬영시간을 구하는 것은 미디어플레이어나 Powershell 또는 Exiftool 이나 FFMPEG 등을 이용할 수 있는데
여기서는 간단히 Shell32 의 도움을 받아 ShellFolder 의 .ExtendedProperty("Property Name")을 이용하여
mp4파일의 Media Encoding Date 값을 가져와서 기존 파일명을 촬영날짜로 일괄로 바꿔줍니다.
추가로 비디오 해상도, 재생시간, 오디오 bps등 탐색기 파일 속성의 자세한 등록정보 정도의 간단한 정보도 표시해줍니다.
첨부한 xlsm 파일을 탐색기 속성에서 차단해제 적용 후에
매크로 컨텐츠를 허용해서 열어줍니다.
1. Get Folder 를 클릭하여 mp4파일이 있는 폴더를 지정합니다. 직접 입력해도 됩니다.
2. Get MP4 Info 를 클릭하여 파일목록과 미디어정보를 불러옵니다.
*.mp4만 대상으로 정보를 가져옵니다.
파일명 G로 시작하고 8글자이면 고프로 동영상 파일로 생각하고
촬영날짜형식( YYYYMMDD_HHMMSS_기존파일명) 으로 파일이름을 변경할 준비를 합니다.
나중에 고프로로 다시 영상을 옮긴다든지 기존 파일명으로 복구할 수도 있기 때문에 기존 파일명을 보존하도록 했습니다.
엑셀 함수식이기 때문에 원하면 사용자가 추가로 함수를 수정할 수 있습니다.
단, media encoding date 가 한국식 날짜형식이라 영문날짜 시스템에서는 에러가 날 수 있는 복잡한 함수식을 거치고 있습니다. 사용자의 변경을 위해 VBA가 아닌 함수식으로 처리했습니다.
3. 이제 일괄 변경하기 위해 Rename Files를 클릭합니다.
성공인 경우 Success, 실패인 경우 Err 가 뜹니다.
최종 변환된 파일 개수를 알려줍니다.
5. 확인을 누르면 다시 파일 목록을 불러옵니다.
다시 파일 목록을 불러올 때 파일명이 중간에 _G가 들어 있고 글자개수가 맞다면 촬영시간으로 이미 파일명이 변경된 것으로 판단하고 기존 파일명으로 다시 복구변경할 준비를 합니다. 다시 Rename Files를 누르면 복구가 되겠습니다.
VBA 소스입니다.
Option Explicit
Sub getFolder()
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Filters.Clear
.InitialFileName = ThisWorkbook.Path & Application.PathSeparator
If .Show Then Range("A2") = .SelectedItems(1)
End With
End Sub
Sub getMp4Info()
Dim ShellApp As Object 'Shell
Dim mPath As String
Dim mFile As String
Dim Sht As Worksheet
Dim i As Long
Dim sDate As String
Set ShellApp = CreateObject("Shell.Application")
If ShellApp Is Nothing Then MsgBox "Shell.Application not found", vbCritical: Exit Sub
Set Sht = ThisWorkbook.ActiveSheet
Sht.UsedRange.Offset(4).ClearContents
'mPath = ThisWorkbook.Path & Application.PathSeparator
mPath = Sht.Range("A2").Value & Application.PathSeparator
If mPath = "" Or Len(Dir(mPath)) = 0 Then MsgBox "경로가 존재하지 않습니다.": Exit Sub
on error resume next '에러무시
mFile = Dir(mPath & "*.mp4")
i = 5
Do While Len(mFile)
Sht.Cells(i, 1) = Left(mFile, InStrRev(mFile, ".") - 1) 'filename
Sht.Cells(i, 2) = Mid(mFile, InStrRev(mFile, ".")) '.ext
'Already renmamed file name
If InStr(Sht.Cells(i, 1), "_G") > 0 And Len(Sht.Cells(i, 1)) >= 24 Then
Sht.Cells(i, 3).Formula = "=mid(A" & i & ",search(""_G"", A" & i & ")+1,8)"
'Gopro file name
ElseIf Len(Sht.Cells(i, 1)) >= 8 And Left(Sht.Cells(i, 1), 1) = "G" Then
Sht.Cells(i, 3).Formula = "=text(Left(F" & i & ", 10), ""yyyymmdd"") & ""_"" & " & _
"TEXT(TIMEVALUE(right(F" & i & ", 8)) + IFERROR(FIND(""오전"", F" & i & "), " & _
"IF(HOUR(TIMEVALUE(right(F" & i & ", 8)))=12,0, TIMEVALUE( ""12:00:00""))) ,""hhmmss"") " & _
" & ""_"" & A" & i
Else
Sht.Cells(i, 3).Formula = "=A" & i
End If
Sht.Cells(i, 4).Formula = "=B" & i
' sht.Cells(i, 6) = GetDetail(ShellApp, mPath & mFile, Mp4Tag.Date_Created)
'sht.Cells(i, 6).NumberFormat = "YYYYMMDD_HH:MM:SS"
sDate = GetDetail(ShellApp, mPath & mFile, "System.Media.DateEncoded")
'sDate = & "_" & Format(timevalue(Mid(sDate, 12), "hhmmss")
Sht.Cells(i, 6) = sDate
Sht.Cells(i, 7).NumberFormat = "hh:mm:ss"
Sht.Cells(i, 7) = str2time(GetDetail(ShellApp, mPath & mFile, "System.Media.Duration"))
Sht.Cells(i, 8) = Round(GetDetail(ShellApp, mPath & mFile, "System.Video.FrameRate") / 1000, 0)
Sht.Cells(i, 9) = Format(GetDetail(ShellApp, mPath & mFile, "System.Video.EncodingBitrate") / 1000, "###,### kbps")
Sht.Cells(i, 10) = GetDetail(ShellApp, mPath & mFile, "System.Video.FrameHeight")
Sht.Cells(i, 11) = GetDetail(ShellApp, mPath & mFile, "System.Video.FrameWidth")
Sht.Cells(i, 12) = Format(GetDetail(ShellApp, mPath & mFile, "System.Video.TotalBitrate") / 1000, "###,### kbps")
Sht.Cells(i, 13) = Format(GetDetail(ShellApp, mPath & mFile, "System.Audio.EncodingBitrate") / 1000, "###,### kbps")
Sht.Cells(i, 14) = GetDetail(ShellApp, mPath & mFile, "System.Audio.ChannelCount")
Sht.Cells(i, 15) = Format(GetDetail(ShellApp, mPath & mFile, "System.Audio.SampleRate") / 1000, "###.000 kHz")
mFile = Dir
i = i + 1
Loop
Set ShellApp = Nothing
End Sub
'convert nano seconds to normal time(hh:mm:ss)
Function str2time(str As String) As Date
str2time = (CDec(str) * 0.0000001) / 86400#
End Function
Function GetDetail(oShellApp As Object, Mp4File As String, PropertyName As String) As String
Dim objFolder2 As Object
Dim fPath As String, fName As String
fPath = Left(Mp4File, InStrRev(Mp4File, Application.PathSeparator))
fName = Mid(Mp4File, InStrRev(Mp4File, Application.PathSeparator) + 1)
Set objFolder2 = oShellApp.Namespace(CStr(fPath))
If (Not objFolder2 Is Nothing) Then
Dim objFolderItem2 As Object
Set objFolderItem2 = objFolder2.ParseName(fName)
If (Not objFolderItem2 Is Nothing) Then
Dim sReturn As String
'https://docs.microsoft.com/en-us/windows/win32/medfound/metadata-properties-for-media-files
GetDetail = objFolderItem2.ExtendedProperty(PropertyName)
'Else
' Debug.Print "FolderItem object returned nothing."
End If
Set objFolderItem2 = Nothing
'Else
' Debug.Print "Folder object returned nothing."
End If
Set objFolder2 = Nothing
End Function
Sub RenameFiles()
Dim Sht As Worksheet
Dim lastRow As Range
Dim D1 As String, F1 As String, F2 As String
Dim rng As Range
Dim i As Integer
Dim SPR As String
SPR = Application.PathSeparator
Set Sht = ActiveSheet
Set lastRow = Sht.Cells(Sht.Rows.Count, "A").End(xlUp)
If lastRow.Row < 5 Then Exit Sub
D1 = Sht.Range("A2") & SPR
For Each rng In Sht.Range("A5", lastRow)
F1 = D1 & rng & rng.Offset(, 1)
F2 = D1 & rng.Offset(, 2) & rng.Offset(, 3)
If Not rng.Offset(, 4).Comment Is Nothing Then rng.Offset(, 4).Comment.Delete
If Len(Dir(F1)) = 0 Then
rng.Offset(, 4) = "-> Err"
rng.Offset(0, 4).AddComment F1 & " not found!"
ElseIf Len(Dir(F2)) > 0 Then
rng.Offset(, 4) = "-> Err"
rng.Offset(0, 4).AddComment F2 & " already exists!"
Else
Name F1 As F2
If Err.Number = 0 Then
rng.Offset(, 4) = "-> Success"
i = i + 1
Else
rng.Offset(, 4) = "-> Err!"
rng.Offset(0, 4).AddComment Err.Description
End If
End If
Next rng
MsgBox i & "개의 파일명을 변경하였습니다. 확인하면 파일정보를 다시 불러옵니다.", vbOKOnly
Call getMp4Info
End Sub
출처: https://konahn.tistory.com/93 [konahn:티스토리]