test

vba_code_common.bas

@@ -0,0 +1,151 @@
+' ============================================================
+' Common VBA Functions for CSV Import/Export
+' ============================================================
+
+' Clean CSV field - remove quotes and trim
+Function CleanCSVField(ByVal field As Variant) As String
+    If IsEmpty(field) Or IsNull(field) Then
+        CleanCSVField = ""
+        Exit Function
+    End If
+    
+    Dim result As String
+    result = Trim(CStr(field))
+    
+    If Len(result) >= 2 Then
+        If Left(result, 1) = """" And Right(result, 1) = """" Then
+            result = Mid(result, 2, Len(result) - 2)
+            result = Replace(result, """""", """")
+        End If
+    End If
+    
+    CleanCSVField = result
+End Function
+
+' Validate CSV column count for all data rows
+' Returns: True if valid, False if any row has wrong column count
+Function ValidateCSVColumnCount(ByRef lines As Variant, ByVal expectedColumns As Long) As Boolean
+    ValidateCSVColumnCount = True
+    
+    Dim lineNum As Long
+    Dim dataArray As Variant
+    Dim validRowCount As Long
+    validRowCount = 0
+    
+    For lineNum = 0 To UBound(lines)
+        If Trim(lines(lineNum)) <> "" Then
+            dataArray = Split(lines(lineNum), ",")
+            If UBound(dataArray) + 1 <> expectedColumns Then
+                MsgBox "CSV line " & (lineNum + 1) & " has " & (UBound(dataArray) + 1) & " columns. Expected " & expectedColumns & ".", vbExclamation
+                ValidateCSVColumnCount = False
+                Exit Function
+            End If
+            validRowCount = validRowCount + 1
+        End If
+    Next lineNum
+    
+    If validRowCount = 0 Then
+        MsgBox "No valid data in CSV.", vbExclamation
+        ValidateCSVColumnCount = False
+    End If
+End Function
+
+' Get last data row in worksheet
+Function GetLastDataRow(ByVal ws As Worksheet, ByVal columnNum As Long) As Long
+    GetLastDataRow = ws.Cells(ws.Rows.Count, columnNum).End(xlUp).Row
+End Function
+
+' Clear data rows from row 7 onwards
+Sub ClearDataRows(ByVal ws As Worksheet, ByVal startRow As Long, ByVal columnNum As Long)
+    Dim lastRow As Long
+    lastRow = ws.Cells(ws.Rows.Count, columnNum).End(xlUp).Row
+    
+    If lastRow >= startRow Then
+        ws.Range(ws.Cells(startRow, 1), ws.Cells(lastRow, 20)).ClearContents
+    End If
+End Sub
+
+' ============================================================
+' File Dialog - Select CSV file
+' Returns: file path or "" if cancelled
+' ============================================================
+Function SelectCSVFile() As String
+    Dim fileDialog As FileDialog
+    Set fileDialog = Application.FileDialog(msoFileDialogFilePicker)
+    
+    With fileDialog
+        .Filters.Clear
+        .Filters.Add "CSV Files", "*.csv"
+        .AllowMultiSelect = False
+        If .Show <> -1 Then
+            SelectCSVFile = ""
+            Exit Function
+        End If
+        SelectCSVFile = .SelectedItems(1)
+    End With
+End Function
+
+' ============================================================
+' Read CSV file with Shift-JIS encoding
+' Returns: array of lines
+' ============================================================
+Function ReadCSVFile(ByVal filePath As String) As Variant
+    If filePath = "" Then
+        ReadCSVFile = Array()
+        Exit Function
+    End If
+    
+    Dim stream As Object
+    Dim textContent As String
+    
+    Set stream = CreateObject("ADODB.Stream")
+    With stream
+        .Type = 2
+        .Charset = "shift_jis"
+        .Open
+        .LoadFromFile filePath
+        textContent = .ReadText
+        .Close
+    End With
+    
+    ReadCSVFile = Split(textContent, vbLf)
+End Function
+
+' ============================================================
+' Get save file path for CSV
+' Returns: file path or "" if cancelled
+' ============================================================
+Function GetSaveCSVPath(Optional ByVal defaultName As String = "") As String
+    Dim savePath As String
+    savePath = Application.GetSaveAsFilename( _
+        FileFilter:="CSV Files (*.csv), *.csv", _
+        Title:="Save CSV", _
+        InitialFileName:=defaultName)
+    
+    If savePath = "False" Or savePath = "" Then
+        GetSaveCSVPath = ""
+        Exit Function
+    End If
+    
+    If InStr(1, savePath, ".csv", vbTextCompare) = 0 Then
+        savePath = savePath & ".csv"
+    End If
+    
+    GetSaveCSVPath = savePath
+End Function
+
+' ============================================================
+' Write content to CSV file with Shift-JIS encoding
+' ============================================================
+Sub WriteCSVFile(ByVal filePath As String, ByVal content As String)
+    Dim stream As Object
+    Set stream = CreateObject("ADODB.Stream")
+    With stream
+        .Type = 2
+        .Charset = "shift_jis"
+        .Open
+        .WriteText content, 1
+        .SaveToFile filePath, 2
+        .Close
+    End With
+End Sub