divide common module into write and read
This commit is contained in:
updsv7
@@ -31,208 +31,6 @@ Sub ClearDataRows(ByVal ws As Worksheet, ByVal startRow As Long, ByVal columnNum
|
||||
End If
|
||||
End Sub
|
||||
|
||||
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
|
||||
|
||||
|
||||
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
|
||||
|
||||
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, 0
|
||||
.SaveToFile filePath, 2
|
||||
.Close
|
||||
End With
|
||||
End Sub
|
||||
|
||||
' Read a CSV file and return its content as a strict 2D array (1-based).
|
||||
' All rows must have the same number of columns as the first row.
|
||||
' If the file is empty and defaultColumnCount > 0, returns an empty 2D array with zero rows and defaultColumnCount columns.
|
||||
' Parameters:
|
||||
' filePath: Full path to the CSV file.
|
||||
' charset: Text encoding (e.g., "cp932", "utf-8").
|
||||
' defaultColumnCount: Optional. Used only if CSV has no rows. Must be >= 0.
|
||||
Function ReadCSVAs2DArrayStrict( _
|
||||
ByVal filePath As String, _
|
||||
ByVal expectedColumnCount As Long, _
|
||||
Optional ByVal charset As String = "cp932", _
|
||||
Optional ByVal hasHeader As Boolean = False) As Variant
|
||||
|
||||
' === validate expectedColumnCount ===
|
||||
If expectedColumnCount <= 0 Then
|
||||
Err.Raise 5001, , "expectedColumnCount must be >= 1."
|
||||
End If
|
||||
|
||||
If Dir(filePath) = "" Then
|
||||
Err.Raise 5002, , "File not found: " & filePath
|
||||
End If
|
||||
|
||||
' === read csv file ===
|
||||
Dim stream As Object
|
||||
Set stream = CreateObject("ADODB.Stream")
|
||||
With stream
|
||||
.Type = 2 ' adTypeText
|
||||
.charset = charset
|
||||
.Open
|
||||
.LoadFromFile filePath
|
||||
Dim textContent As String
|
||||
textContent = .ReadText
|
||||
.Close
|
||||
End With
|
||||
|
||||
' === stardand ===
|
||||
textContent = Replace(textContent, vbCrLf, vbLf)
|
||||
textContent = Replace(textContent, vbCr, vbLf)
|
||||
|
||||
' === transfer into collection ===
|
||||
Dim lines As Collection
|
||||
Set lines = ParseCSVLines(textContent)
|
||||
|
||||
' === validate empty ===
|
||||
If lines.Count = 0 Then
|
||||
Err.Raise 5003, , "CSV file is empty."
|
||||
End If
|
||||
|
||||
' === loop the row, validate column count ===
|
||||
Dim i As Long
|
||||
For i = 1 To lines.Count
|
||||
Dim rowArr As Variant
|
||||
rowArr = lines(i)
|
||||
Dim actualCols As Long
|
||||
actualCols = UBound(rowArr) - LBound(rowArr) + 1
|
||||
|
||||
If actualCols <> expectedColumnCount Then
|
||||
Err.Raise 5004, , "Row " & i & ": Expected " & expectedColumnCount & " columns, got " & actualCols & "."
|
||||
End If
|
||||
Next i
|
||||
|
||||
Dim result As Variant
|
||||
ReDim result(1 To lines.Count, 1 To expectedColumnCount)
|
||||
|
||||
For i = 1 To lines.Count
|
||||
rowArr = lines(i)
|
||||
Dim j As Long
|
||||
For j = LBound(rowArr) To UBound(rowArr)
|
||||
result(i, j - LBound(rowArr) + 1) = rowArr(j)
|
||||
Next j
|
||||
Next i
|
||||
|
||||
ReadCSVAs2DArrayStrict = result
|
||||
End Function
|
||||
|
||||
' Helper function: Parse CSV text into collection of string arrays (zero-based per row)
|
||||
Private Function ParseCSVLines(ByVal csvText As String) As Collection
|
||||
Set ParseCSVLines = New Collection
|
||||
Dim length As Long: length = Len(csvText)
|
||||
If length = 0 Then Exit Function
|
||||
|
||||
Dim i As Long: i = 1
|
||||
Dim currentField As String
|
||||
Dim currentRow As Collection: Set currentRow = New Collection
|
||||
Dim inQuotes As Boolean
|
||||
Dim c As String
|
||||
|
||||
Do While i <= length
|
||||
c = Mid$(csvText, i, 1)
|
||||
Select Case c
|
||||
Case """"
|
||||
If inQuotes Then
|
||||
If i < length And Mid$(csvText, i + 1, 1) = """" Then
|
||||
currentField = currentField & """"
|
||||
i = i + 2
|
||||
Else
|
||||
inQuotes = False
|
||||
i = i + 1
|
||||
End If
|
||||
Else
|
||||
inQuotes = True
|
||||
i = i + 1
|
||||
End If
|
||||
Case ","
|
||||
If inQuotes Then
|
||||
currentField = currentField & c
|
||||
i = i + 1
|
||||
Else
|
||||
currentRow.Add currentField
|
||||
currentField = ""
|
||||
i = i + 1
|
||||
End If
|
||||
Case vbLf
|
||||
If inQuotes Then
|
||||
currentField = currentField & c
|
||||
i = i + 1
|
||||
Else
|
||||
currentRow.Add currentField
|
||||
Dim arr() As String
|
||||
If currentRow.Count > 0 Then
|
||||
ReDim arr(0 To currentRow.Count - 1)
|
||||
Dim k As Long
|
||||
For k = 1 To currentRow.Count
|
||||
arr(k - 1) = currentRow(k)
|
||||
Next k
|
||||
End If
|
||||
ParseCSVLines.Add arr
|
||||
Set currentRow = New Collection
|
||||
currentField = ""
|
||||
inQuotes = False
|
||||
i = i + 1
|
||||
End If
|
||||
Case Else
|
||||
currentField = currentField & c
|
||||
i = i + 1
|
||||
End Select
|
||||
Loop
|
||||
|
||||
' Handle last row without trailing newline
|
||||
If currentField <> "" Or currentRow.Count > 0 Then
|
||||
currentRow.Add currentField
|
||||
Dim lastArr() As String
|
||||
If currentRow.Count > 0 Then
|
||||
ReDim lastArr(0 To currentRow.Count - 1)
|
||||
Dim m As Long
|
||||
For m = 1 To currentRow.Count
|
||||
lastArr(m - 1) = currentRow(m)
|
||||
Next m
|
||||
End If
|
||||
ParseCSVLines.Add lastArr
|
||||
End If
|
||||
End Function
|
||||
|
||||
Sub SortDataRows(Optional ByVal sortColumn As Long = 3)
|
||||
Dim ws As Worksheet
|
||||
Dim lastRow As Long
|
||||
|
||||
168
vba_code_read_csv_common.bas
Normal file
168
vba_code_read_csv_common.bas
Normal file
@@ -0,0 +1,168 @@
|
||||
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 a CSV file and return its content as a strict 2D array (1-based).
|
||||
' All rows must have the same number of columns as the first row.
|
||||
' If the file is empty and defaultColumnCount > 0, returns an empty 2D array with zero rows and defaultColumnCount columns.
|
||||
' Parameters:
|
||||
' filePath: Full path to the CSV file.
|
||||
' charset: Text encoding (e.g., "cp932", "utf-8").
|
||||
' defaultColumnCount: Optional. Used only if CSV has no rows. Must be >= 0.
|
||||
Function ReadCSVAs2DArrayStrict( _
|
||||
ByVal filePath As String, _
|
||||
ByVal expectedColumnCount As Long, _
|
||||
Optional ByVal charset As String = "cp932", _
|
||||
Optional ByVal hasHeader As Boolean = False) As Variant
|
||||
|
||||
' === validate expectedColumnCount ===
|
||||
If expectedColumnCount <= 0 Then
|
||||
Err.Raise 5001, , "expectedColumnCount must be >= 1."
|
||||
End If
|
||||
|
||||
If Dir(filePath) = "" Then
|
||||
Err.Raise 5002, , "File not found: " & filePath
|
||||
End If
|
||||
|
||||
' === read csv file ===
|
||||
Dim stream As Object
|
||||
Set stream = CreateObject("ADODB.Stream")
|
||||
With stream
|
||||
.Type = 2 ' adTypeText
|
||||
.charset = charset
|
||||
.Open
|
||||
.LoadFromFile filePath
|
||||
Dim textContent As String
|
||||
textContent = .ReadText
|
||||
.Close
|
||||
End With
|
||||
|
||||
' === stardand ===
|
||||
textContent = Replace(textContent, vbCrLf, vbLf)
|
||||
textContent = Replace(textContent, vbCr, vbLf)
|
||||
|
||||
' === transfer into collection ===
|
||||
Dim lines As Collection
|
||||
Set lines = ParseCSVLines(textContent)
|
||||
|
||||
' === validate empty ===
|
||||
If lines.Count = 0 Then
|
||||
Err.Raise 5003, , "CSV file is empty."
|
||||
End If
|
||||
|
||||
' === loop the row, validate column count ===
|
||||
Dim i As Long
|
||||
For i = 1 To lines.Count
|
||||
Dim rowArr As Variant
|
||||
rowArr = lines(i)
|
||||
Dim actualCols As Long
|
||||
actualCols = UBound(rowArr) - LBound(rowArr) + 1
|
||||
|
||||
If actualCols <> expectedColumnCount Then
|
||||
Err.Raise 5004, , "Row " & i & ": Expected " & expectedColumnCount & " columns, got " & actualCols & "."
|
||||
End If
|
||||
Next i
|
||||
|
||||
Dim result As Variant
|
||||
ReDim result(1 To lines.Count, 1 To expectedColumnCount)
|
||||
|
||||
For i = 1 To lines.Count
|
||||
rowArr = lines(i)
|
||||
Dim j As Long
|
||||
For j = LBound(rowArr) To UBound(rowArr)
|
||||
result(i, j - LBound(rowArr) + 1) = rowArr(j)
|
||||
Next j
|
||||
Next i
|
||||
|
||||
ReadCSVAs2DArrayStrict = result
|
||||
End Function
|
||||
|
||||
' Helper function: Parse CSV text into collection of string arrays (zero-based per row)
|
||||
Private Function ParseCSVLines(ByVal csvText As String) As Collection
|
||||
Set ParseCSVLines = New Collection
|
||||
Dim length As Long: length = Len(csvText)
|
||||
If length = 0 Then Exit Function
|
||||
|
||||
Dim i As Long: i = 1
|
||||
Dim currentField As String
|
||||
Dim currentRow As Collection: Set currentRow = New Collection
|
||||
Dim inQuotes As Boolean
|
||||
Dim c As String
|
||||
|
||||
Do While i <= length
|
||||
c = Mid$(csvText, i, 1)
|
||||
Select Case c
|
||||
Case """"
|
||||
If inQuotes Then
|
||||
If i < length And Mid$(csvText, i + 1, 1) = """" Then
|
||||
currentField = currentField & """"
|
||||
i = i + 2
|
||||
Else
|
||||
inQuotes = False
|
||||
i = i + 1
|
||||
End If
|
||||
Else
|
||||
inQuotes = True
|
||||
i = i + 1
|
||||
End If
|
||||
Case ","
|
||||
If inQuotes Then
|
||||
currentField = currentField & c
|
||||
i = i + 1
|
||||
Else
|
||||
currentRow.Add currentField
|
||||
currentField = ""
|
||||
i = i + 1
|
||||
End If
|
||||
Case vbLf
|
||||
If inQuotes Then
|
||||
currentField = currentField & c
|
||||
i = i + 1
|
||||
Else
|
||||
currentRow.Add currentField
|
||||
Dim arr() As String
|
||||
If currentRow.Count > 0 Then
|
||||
ReDim arr(0 To currentRow.Count - 1)
|
||||
Dim k As Long
|
||||
For k = 1 To currentRow.Count
|
||||
arr(k - 1) = currentRow(k)
|
||||
Next k
|
||||
End If
|
||||
ParseCSVLines.Add arr
|
||||
Set currentRow = New Collection
|
||||
currentField = ""
|
||||
inQuotes = False
|
||||
i = i + 1
|
||||
End If
|
||||
Case Else
|
||||
currentField = currentField & c
|
||||
i = i + 1
|
||||
End Select
|
||||
Loop
|
||||
|
||||
' Handle last row without trailing newline
|
||||
If currentField <> "" Or currentRow.Count > 0 Then
|
||||
currentRow.Add currentField
|
||||
Dim lastArr() As String
|
||||
If currentRow.Count > 0 Then
|
||||
ReDim lastArr(0 To currentRow.Count - 1)
|
||||
Dim m As Long
|
||||
For m = 1 To currentRow.Count
|
||||
lastArr(m - 1) = currentRow(m)
|
||||
Next m
|
||||
End If
|
||||
ParseCSVLines.Add lastArr
|
||||
End If
|
||||
End Function
|
||||
@@ -1,3 +1,22 @@
|
||||
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
|
||||
|
||||
' Writes a 2D array to a CSV file
|
||||
Sub WriteCSVFromArray( _
|
||||
ByVal filePath As String, _
|
||||
|
||||
Reference in New Issue
Block a user