ray88’s diary

お仕事で困ったとき用の自分用の覚書

ExcelVBA Excel→UTF8(BOMなし)へ変換

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