Sub main()
Dim p As String
Dim f As String


p = "C:\test\"  '対象ﾌｫﾙﾀﾞを指定してください｡
f = "a.csv"  '対象ﾌｧｲﾙを指定してください｡

Call jikkou(p, f)

End Sub


Sub jikkou(p As String, f As String)

 dt = Format(Now(), "yyyyMMdd")
 
 ch1 = FreeFile
 Open p & f For Input As #ch1
 
 Do While Not EOF(ch1)  'ﾌｧｲﾙの終端かどうかを確認します
 Line Input #ch1, textline  'ﾃﾞｰﾀ行を読み込みます
 
 f = 0
 g = 0
 h = ""
 For e = 1 To Len(textline)
 If Mid(textline, e, 1) <> "," And g = 4 Then
 h = h & Mid(textline, e, 1)
 End If
 If Mid(textline, e, 1) = """" And f = 0 Then
 f = 1
 End If
 If Mid(textline, e, 1) = """" And f = 1 Then
 f = 0
 End If
 If Mid(textline, e, 1) = "," And f = 0 Then
 g = g + 1
 If g >= 5 Then Exit For
 End If
 Next e
 
 
 ch2 = FreeFile
 Open p & dt & h & ".csv" For Append As #ch2
 Print #ch2, textline  'ﾃﾞｰﾀの書き込みをします
 Close #ch2
 
 Loop
 Close #ch1
 
End Sub

起動するときは､以下の設定をしてから実行してください｡
p = "C:\test\" '対象ﾌｫﾙﾀﾞを指定してください｡
f = "a.csv" '対象ﾌｧｲﾙを指定してください｡