Option Explicit

Sub delTopLineSub(path As String, fname As String)
 Dim buf As String
 Dim fname1 As String, fname2 As String
 fname1 = path & fname
 fname2 = path & fname & ".$$$"
 Open fname1 For Input As #1
 Open fname2 For Output As #2
 Line Input #1, buf  '1行目読み飛ばし
 Do Until EOF(1)
 Line Input #1, buf
 Print #2, buf
 Loop
 Close #1
 Close #2
 Kill fname1  'ｵﾘｼﾞﾅﾙ･ﾌｧｲﾙ削除
 Name fname2 As fname1
End Sub

Sub delTopLine(path As String, ext As String)
 Dim fname As String
 fname = Dir(path & "*." & ext, vbNormal)
 Do While fname <> ""
 Call delTopLineSub(path, fname)
 fname = Dir()
 Loop
End Sub


Sub main()
 Call delTopLine("C:\test\", "txt")
End Sub

Public w As Workbook
Public 読み込み数 As Long
Public ｶﾗﾑ数 As Integer

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

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

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)
 w.Sheets(1).Rows(1).Delete Shift:=xlUp
 読み込み数 = 読み込み数 - 1
 Call WRITE_CSVFile(p & f & "wrk")
 w.Close
 Kill p & f
 Name p & f & "wrk" As p & f

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
 ｶﾗﾑ数 = 0
 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
 If ｶﾗﾑ数 < i Then ｶﾗﾑ数 = i
 Loop
 
 
 Close #FNo
読み込み数 = lRowCnt - 1
End If

End Sub

Sub WRITE_CSVFile(pa As String)
 Dim GYO As Long  ' 収容するｾﾙの行
 Dim GYOMAX As Long  ' ﾃﾞｰﾀが収容された最終行
 Dim strREC As String
 Dim FNo As Integer
 
 Dim lRowCnt As Long
 
 FNo = FreeFile
 
  ' 指定ﾌｧｲﾙをOPEN(出力ﾓｰﾄﾞ)
 Open pa For Output As #FNo

  ' 最終行の取得
 With w.Sheets(1)
 GYO = 1
  ' 最終行まで繰り返す
 Do Until GYO > 読み込み数
  ' ﾚｺｰﾄﾞを出力(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