add new write csv common module

vba_code_kotsu_master.bas

@@ -53,10 +53,11 @@ Sub Z1_ExportMasterDetailData()
     Dim ws As Worksheet
     Dim lastDataRow As Long
     Dim savePath As String
-    Dim csvContent As String
     Dim r As Long
-    Dim j As Long
     Dim rowCount As Long
+    Dim dataArray() As Variant
+    Dim dataIdx As Long
+    Dim j As Long
     
     Set ws = ActiveSheet
     
@@ -70,28 +71,36 @@ Sub Z1_ExportMasterDetailData()
     savePath = GetSaveCSVPath()
     If savePath = "" Then Exit Sub
     
-    ' Build data rows (no header) - CSV 1-7 = C-I
+    ' Count valid rows first (C column non-empty from row 7 onward)
     rowCount = 0
     For r = 7 To lastDataRow
         If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then
             rowCount = rowCount + 1
-            For j = 3 To 9
-                If j = 3 Then
-                    csvContent = csvContent & CleanCSVField(ws.Cells(r, j).Value)
-                Else
-                    csvContent = csvContent & "," & CleanCSVField(ws.Cells(r, j).Value)
-                End If
-            Next j
-            csvContent = csvContent & vbLf
         End If
     Next r
     
-    ' Trim trailing
+    ' If no data, exit
-    Do While Right(csvContent, 1) = vbLf
+    If rowCount = 0 Then
-        csvContent = Left(csvContent, Len(csvContent) - 1)
+        MsgBox "No data rows to output.", vbExclamation
-    Loop
+        Exit Sub
+    End If
     
-    Call WriteCSVFile(savePath, csvContent)
+    ' Initialize 2D array: (1 To rowCount, 1 To 7) for columns C-I (3 to 9)
+    ReDim dataArray(1 To rowCount, 1 To 7)
+    
+    ' Fill the array
+    dataIdx = 0
+    For r = 7 To lastDataRow
+        If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then
+            dataIdx = dataIdx + 1
+            For j = 3 To 9
+                dataArray(dataIdx, j - 2) = ws.Cells(r, j).Value ' C->1, D->2, ..., I->7
+            Next j
+        End If
+    Next r
+    
+    ' Write using the new array-based CSV writer
+    Call WriteCSVFromArray(savePath, dataArray, "utf-8", True)
     
     MsgBox "CSV export completed. Total data rows: " & rowCount, vbInformation
 End Sub

vba_code_write_csv_common.bas

@@ -0,0 +1,119 @@
+' Writes a 2D array to a CSV file
+Sub WriteCSVFromArray( _
+    ByVal filePath As String, _
+    ByVal data As Variant, _
+    Optional ByVal Charset As String = "shift_jis", _
+    Optional ByVal alwaysQuote As Boolean = False _
+)
+    ' === Input validation ===
+    If Not IsArray(data) Then
+        Err.Raise 513, , "Input 'data' must be an array."
+    End If
+    
+    Dim numDims As Long
+    On Error Resume Next
+    numDims = ArrayDimensions(data)
+    On Error GoTo 0
+    If numDims <> 2 Then
+        Err.Raise 514, , "Input array must be 2-dimensional."
+    End If
+    
+    Dim rows As Long, cols As Long
+    rows = UBound(data, 1) - LBound(data, 1) + 1
+    cols = UBound(data, 2) - LBound(data, 2) + 1
+    
+    If rows = 0 Or cols = 0 Then Exit Sub ' Empty array, exit early
+    
+    ' === Build CSV content ===
+    Dim outputLines As Collection
+    Set outputLines = New Collection
+    
+    Dim i As Long, j As Long
+    Dim rowStr As String
+    Dim field As String
+    Dim needsQuote As Boolean
+    
+    For i = LBound(data, 1) To UBound(data, 1)
+        Dim fields As Variant
+        ReDim fields(1 To cols)
+        
+        For j = LBound(data, 2) To UBound(data, 2)
+            ' Safely convert variant to string
+            field = SafeToString(data(i, j))
+            
+            ' Determine if the field needs quoting (per RFC 4180)
+            needsQuote = alwaysQuote Or (InStr(field, """") > 0) Or _
+                                       (InStr(field, ",") > 0) Or _
+                                       (InStr(field, vbLf) > 0) Or _
+                                       (InStr(field, vbCrLf) > 0) Or _
+                                       (InStr(field, vbCr) > 0) Or _
+                                       (Left(field, 1) = " " Or Right(field, 1) = " ")
+            
+            If needsQuote Then
+                ' Escape double quotes: "" represents a single "
+                field = """" & Replace(field, """", """""") & """"
+            End If
+            
+            fields(j - LBound(data, 2) + 1) = field
+        Next j
+        
+        rowStr = Join(fields, ",")
+        outputLines.Add rowStr
+    Next i
+    
+    ' Concatenate all lines
+    Dim finalContent As String
+    finalContent = Join(CollectionToArray(outputLines), vbCrLf)
+    
+    ' === Write to file ===
+    Dim stream As Object
+    Set stream = CreateObject("ADODB.Stream")
+    With stream
+        .Type = 2 ' adTypeText
+        .Charset = Charset
+        .Open
+        .WriteText finalContent, 0 ' adWriteChar
+        .SaveToFile filePath, 2 ' adSaveCreateOverWrite
+        .Close
+    End With
+End Sub
+
+' Helper function: safely convert any Variant to a string
+Private Function SafeToString(ByVal v As Variant) As String
+    On Error Resume Next
+    If IsNull(v) Or IsEmpty(v) Then
+        SafeToString = ""
+    Else
+        SafeToString = CStr(v)
+    End If
+    On Error GoTo 0
+End Function
+
+' Helper function: get the number of dimensions of an array (1, 2, ...)
+Private Function ArrayDimensions(arr As Variant) As Long
+    Dim dimCount As Long
+    On Error GoTo ExitPoint
+    Do
+        dimCount = dimCount + 1
+        Dim tmp As Long
+        tmp = UBound(arr, dimCount)
+    Loop
+ExitPoint:
+    ArrayDimensions = dimCount - 1
+End Function
+
+' Helper function: convert a Collection to a 1D array (for use with Join)
+Private Function CollectionToArray(col As Collection) As Variant
+    If col.Count = 0 Then
+        CollectionToArray = Array()
+        Exit Function
+    End If
+    
+    Dim arr() As String
+    ReDim arr(1 To col.Count)
+    Dim i As Long
+    For i = 1 To col.Count
+        arr(i) = col(i)
+    Next i
+    CollectionToArray = arr
+End Function