Excel2Csv

Option Explicit

Public Sub Main()
    
    Dim dataFileDirPath As String
    Dim fileNameList As String
    Dim tgtFileList As Collection
    
    dataFileDirPath = ThisWorkbook.path & "\" & "datafiles"
    Set tgtFileList = FNC_getDataFileList(dataFileDirPath, "*.xls")
    
    Dim v As Variant
    Dim singleLineString As String
    Dim fileOutStrings As New Collection
    
    For Each v In tgtFileList
        'ここで各エクセルからのCSV形式テキスト１行を受け取る
        singleLineString = FNC_getStringFromExcelBook(dataFileDirPath & "\" & v, "CsvOut", "B1:B12")
        fileOutStrings.Add singleLineString
    Next
    
    Dim z As Boolean
    z = FNC_fileOut(fileOutStrings, ThisWorkbook.path, "out_" & Format(Now, "yyyymmdd-HHmmss") & ".csv")
    
End Sub


Public Function FNC_getDataFileList(dirPath As String, fileSpec As String) As Collection
    
    Dim dataFileList As New Collection
    Dim filename As String
    
    'example: C:\datafiles\*.txt
    filename = Dir(dirPath & "\" & fileSpec, vbNormal)
    Do While filename <> ""
        dataFileList.Add filename
        filename = Dir()
    Loop
    
    'return
    Set FNC_getDataFileList = dataFileList
    
End Function


Public Function FNC_getStringFromExcelBook(fileFullPath As String, csvSheetName As String, rangeString As String) As String
    
    Dim returnString As String
    Dim outCsvColList As New Collection
    Dim rng As Range
    
    Workbooks.Open (fileFullPath)
        Sheets(csvSheetName).Select
        Set rng = Sheets(csvSheetName).Range(rangeString)
        returnString = FNC_buildCsvStringFromRange(rng)
    Application.DisplayAlerts = False
    ActiveWorkbook.Close
    Application.DisplayAlerts = True
    
    'return
    FNC_getStringFromExcelBook = returnString
    
End Function


Public Function FNC_buildCsvStringFromRange(rng As Range)
    
    Dim outCsvColList As New Collection
    Dim returnString As String
    Dim x, y As Integer
    For y = 1 To rng.Rows.Count
        For x = 1 To rng.Columns.Count
            outCsvColList.Add rng.Cells(y, x).Value
        Next x
    Next y
    returnString = FNC_buildCsvStringFromCollection(outCsvColList)
    
    'return
    FNC_buildCsvStringFromRange = returnString

End Function


Public Function FNC_buildCsvStringFromCollection(stringList As Collection) As String
    
    Dim returnString As String
    Dim isFirstLine As Boolean
    isFirstLine = True
    
    Dim v As Variant
    For Each v In stringList
        If (isFirstLine) Then
            isFirstLine = False
            returnString = returnString & """" & v & """"
        Else
            returnString = returnString & ",""" & v & """"
        End If
    Next
    
    'return
    FNC_buildCsvStringFromCollection = returnString
    
End Function


Public Function FNC_fileOut(fileOutStrings As Collection, outDirPath As String, outFileName As String) As Boolean
    
    Dim fso As New Scripting.FileSystemObject
    Dim stream As TextStream
    Dim fullPath As String
    Dim v As Variant
    
    fullPath = fso.BuildPath(outDirPath, outFileName)
    
    Set stream = fso.CreateTextFile(fullPath, True, False)
        For Each v In fileOutStrings
            stream.WriteLine v
        Next
    stream.Close
    
    FNC_fileOut = True
    
End Function