add new write csv common module

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