Sub main()
Dim p As String
'対象ﾌｫﾙﾀﾞを指定してください｡
'このﾌｫﾙﾀﾞに この実行用のﾌﾞｯｸは 入れないでください｡
p = "C:\test\"

'処理対象となる拡張子を指定して 呼び出します｡
Call jikkou(p, "csv")

End Sub


Sub jikkou(p As String, s As String)

Dim bk As Workbook
Dim gg As Long
Application.DisplayAlerts = False

Dim fdb() As String
 
a = 1
f = Dir(p & "*." & s, vbNormal)
Do While f <> ""
 ReDim Preserve fdb(a)
 fdb(a - 1) = f
 a = a + 1
 f = Dir
Loop


For aaa = 0 To a - 2
 f = fdb(aaa)
 csvout (p & f)
Next aaa

Application.DisplayAlerts = True

End Sub


Sub csvout(csFName As String)

 
 Dim FNo As Integer
 
 Dim wsObj As Worksheet
 
 Dim strGet As String
 
 Dim lRowCnt As Long
 
 Dim i As Long
 Dim outdata() As String
 
 
 FNo = FreeFile
 
 If Dir(csFName) <> "" Then
 
 Open csFName For Input As #FNo
 
 lRowCnt = 1
 
 Do Until EOF(FNo)
 no_out = 0
 Line Input #FNo, strGet
 
 f = 0
 For b = 1 To Len(strGet) - 1
 If Mid(strGet, b, 1) = """" Then
 If f = 1 Then
 f = 0
 Else
 f = 1
 End If
 End If
 
 If Mid(strGet, b, 1) = "," Then
 If f = 1 Then
  'ﾀﾞﾌﾞﾙｸｵｰﾃｼｮﾝの中で ｶﾝﾏありは 出力しない
 no_out = 1
 End If
 Exit For
 End If
 
 If Mid(strGet, b, 1) = "@" Then
 d = Mid(strGet, b + 1, 1)
 If d >= "0" And d <= "9" Then
 no_out = 1
 Exit For
 End If
 End If
 Next b
 
 If no_out = 0 Then
 ReDim Preserve outdata(lRowCnt)
 outdata(lRowCnt) = strGet
 lRowCnt = lRowCnt + 1
 End If
 Loop
 
 Close #FNo
 
 FNo = FreeFile
 Open csFName & "$$$" For Output As #FNo
 For b = 1 To lRowCnt - 1
 Print #FNo, outdata(b)
 Next b
 Close #FNo
 
 Kill csFName  'ｵﾘｼﾞﾅﾙ･ﾌｧｲﾙ削除
 Name csFName & "$$$" As csFName
 
 End If
End Sub