Public w As Workbook
Public 読み込み数 As Integer

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)

 csvImp (p & f)
 w.Sheets(1).Columns("A:A").Copy w.Sheets(1).Columns("S:S")
 
 w.Save
 w.Close
 
Next aaa

Application.DisplayAlerts = True

End Sub


Sub csvImp(csFName As String)

Const csDelimiter As String = ","

Dim FNo As Integer

Dim wsObj As Worksheet

Dim strGet As String

Dim lRowCnt As Long

Dim i As Long

FNo = FreeFile
読み込み数 = 0

If Dir(csFName) <> "" Then

 Open csFName For Input As #FNo
 Set w = Workbooks.Open(Filename:=csFName, UpdateLinks:=False, ReadOnly:=False)
 
 Set wsObj = Workbooks(w.Name).Sheets(1)
 lRowCnt = 1
 
 Do Until EOF(FNo)
 
 Line Input #FNo, strGet
 
 For i = LBound(Split(strGet, csDelimiter)) To UBound(Split(strGet, csDelimiter))
 
 If IsNumeric(Split(strGet, csDelimiter)(i)) = True And Left(Split(strGet, csDelimiter)(i), 1) = "0" Then
 
 wsObj.Cells(lRowCnt, i + 1).NumberFormatLocal = "@"
 
 End If
 
 wsObj.Cells(lRowCnt, i + 1) = Split(strGet, csDelimiter)(i)
 
 Next i
 If 読み込み数 > i Then
 読み込み数 = i
 End If
 lRowCnt = lRowCnt + 1
 
 Loop
 
 
 Close #FNo

End If

End Sub


Sub WRITE_CSVFile(cnsFILENAME As String)
 Dim GYO As Long  ' 収容するｾﾙの行
 Dim GYOMAX As Long  ' ﾃﾞｰﾀが収容された最終行
 Dim strREC As String
 Dim FNo As Integer
 
 Dim lRowCnt As Long
 
 FNo = FreeFile

  ' 最終行の取得
 With w.Sheets(1)
 If .Range("F1") = "" Then
 Exit Sub
 End If
 
 If .Range("F2") = "" Then
 ff = 1
 Else
 ff = .Range("F1").End(xlDown).Row
 End If
 
  ' 指定ﾌｧｲﾙをOPEN(出力ﾓｰﾄﾞ)
 Open cnsFILENAME For Output As #FNo
 
  ' 1行目から開始
 GYO = 1
  ' 最終行まで繰り返す
 Do Until GYO > ff
  ' ﾚｺｰﾄﾞを出力(REC編集処理より受け取る)
 strREC = .Cells(GYO, 1).Value
 For COL = 2 To 読み込み数
 strREC = strREC & "," & .Cells(GYO, COL).Value
 Next COL
 
 Print #FNo, strREC
  ' 行を加算
 GYO = GYO + 1
 Loop
 End With
 
 Close #FNo
End Sub

Public w As Workbook

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)
 f1 = Left(f, Len(f) - 4)

 csvImp (p & f)
 With w.Sheets(1)
 
 If .Range("A2") = "" Then
 ff = 1
 Else
 ff = .Range("A1").End(xlDown).Row
 End If
 
 For gg = 1 To ff
 .Cells(gg, "S") = f1
 Next gg
 End With
 
 w.Save
 w.Close
 
Next aaa

Application.DisplayAlerts = True

End Sub


Sub csvImp(csFName As String)

Const csDelimiter As String = ","

Dim FNo As Integer

Dim wsObj As Worksheet

Dim strGet As String

Dim lRowCnt As Long

Dim i As Long

FNo = FreeFile

If Dir(csFName) <> "" Then

 Open csFName For Input As #FNo
 Set w = Workbooks.Open(Filename:=csFName, UpdateLinks:=False, ReadOnly:=False)
 
 Set wsObj = Workbooks(w.Name).Sheets(1)
 lRowCnt = 1
 
 Do Until EOF(FNo)
 
 Line Input #FNo, strGet
 
 For i = LBound(Split(strGet, csDelimiter)) To UBound(Split(strGet, csDelimiter))
 
 If IsNumeric(Split(strGet, csDelimiter)(i)) = True And Left(Split(strGet, csDelimiter)(i), 1) = "0" Then
 
 wsObj.Cells(lRowCnt, i + 1).NumberFormatLocal = "@"
 
 End If
 
 wsObj.Cells(lRowCnt, i + 1) = Split(strGet, csDelimiter)(i)
 
 Next i
 
 lRowCnt = lRowCnt + 1
 
 Loop
 
 
 Close #FNo

End If

End Sub