ExcelVBA 目次 - ray88’s diary
【BOMなし・改行コードはUnix(LF)】
Sub ConvertExcelToUTF8CSVWithoutBOM_LF(filePath As String) Dim wb As Workbook Dim ws As Worksheet Dim rng As Range Dim cell As Range Dim r As Long, c As Long Dim csvContent As String Dim csvPath As String Dim strStream As Object, binaryStream As Object Dim byteData() As Byte ' Open the Excel file Set wb = Workbooks.Open(filePath) Set ws = wb.Sheets(1) Set rng = ws.UsedRange ' Loop through each cell in the used range For r = 1 To rng.Rows.Count For c = 1 To rng.Columns.Count Set cell = rng.Cells(r, c) ' Add cell content to CSV string csvContent = csvContent & cell.Value ' Add comma for next column unless it's the last column If c < rng.Columns.Count Then csvContent = csvContent & "," End If Next c ' Move to the next line using Unix (LF) line ending csvContent = csvContent & vbLf Next r ' Convert the content to UTF-8 encoding without BOM Set strStream = CreateObject("ADODB.Stream") strStream.Charset = "UTF-8" strStream.Open strStream.WriteText csvContent strStream.Position = 3 ' Skip the BOM Set binaryStream = CreateObject("ADODB.Stream") binaryStream.Type = 1 ' adTypeBinary binaryStream.Open strStream.CopyTo binaryStream strStream.Close ' Save the content to a CSV file csvPath = Replace(filePath, ".xlsx", ".csv") binaryStream.SaveToFile csvPath, 2 ' 2 = adSaveCreateOverWrite binaryStream.Close ' Close the workbook without saving wb.Close SaveChanges:=False MsgBox "CSV conversion completed! Saved as: " & csvPath End Sub