質問です。

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

    csvImp (p & f)
    Call WRITE_CSVFile(p)
    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(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

    ' 最終行の取得
    With w.Sheets(1)
        If .Range("S1") = "" Then
            Exit Sub
        End If
    
        If .Range("S2") = "" Then
            ff = 1
        Else
            ff = .Range("S1").End(xlDown).Row
        End If
        cnsFILENAME = ""
    
        str見出し = .Cells(1, 1).Value
        For COL = 2 To 読み込み数
            str見出し = str見出し & "," & .Cells(1, COL).Value
        Next COL
        
        
        ' 2行目から開始
        GYO = 2
        ' 最終行まで繰り返す
        Do Until GYO > ff
            If cnsFILENAME <> .Cells(GYO, "S") Then
                If cnsFILENAME <> "" Then
                    Close #FNo
                End If
                cnsFILENAME = .Cells(GYO, "S")
            
                ' 指定ファイルをOPEN(出力モード)
                Open pa & cnsFILENAME + ".csv" For Output As #FNo
                Print #FNo, str見出し
                
            End If
            ' レコードを出力(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

大丈夫かな？