' ============================================================ ' Common Functions ' ============================================================ 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 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 Function GetLastDataRow(ByVal ws As Worksheet, ByVal columnNum As Long) As Long GetLastDataRow = ws.Cells(ws.Rows.Count, columnNum).End(xlUp).Row End Function 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 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 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 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, 1 .SaveToFile filePath, 2 .Close End With End Sub