匯入csv檔案

Private Sub Inport_Renkei_CSV_Click_Click()
    Dim rowIndex As Integer, item As Integer
    Dim fileName As String, currLine As String, rowDataArr() As String
    fileName = Application.GetOpenFilename("連攜CSVファイル(*.csv),*.csv")
    VarType (fileName)
    If fileName = "False" Then
        Exit
 
 Sub
    End If

    rowIndex = 0
    Open fileName For Input As #1
    Do While Not EOF(1)
        Line Input #1, currLine
        rowDataArr = Split(currLine, Chr(44))
        For item = 0 To UBound(rowDataArr)
            If Left(rowDataArr(item), 1) = Chr(34) And Right(rowDataArr(item), 1) = Chr(34
 
) Then
                rowDataArr(item) = Mid(rowDataArr(item), 2, Len(rowDataArr(item)) - 2)
            End If
            Cells(rowIndex + 1, item + 1).NumberFormatLocal = "@"
            Cells(rowIndex + 1, item + 1).FormulaR1C1 = rowDataArr(item)
        Next item
        rowIndex = rowIndex + 1
 

    Loop
    Close #1

    MsgBox "success"
End Sub

匯出csv檔案

Private Sub Export_Renkei_CSV_Click_Click ()

    Dim fileName As Variant, newFileName As String
    Dim tatolRow As Long, tatolCol As Long
    Dim row As Long, col As Long
    Dim item As Long

    With Sheet1.UsedRange
        tatolRow = .Rows.Count
        tatolCol = .Columns.Count
    End With

    newFileName = "csv"

    fileName = Application.GetSaveAsFilename(InitialFileName:=fileName + newFileName, FileFilter:="連攜CSVファイル(*.csv),*.csv")

    If VarType(fileName) = vbBoolean Then
        Exit Sub
    End If

    Dim fileSysObj, createFile As Object

    Set fileSysObj = CreateObject("Scripting.FileSystemObject")
    Set createFile = fileSysObj.createtextfile(fileName)

    Dim XheadData As Variant
    XheadData = Rows(1)
    Dim headLine As String
    headLine = ""

    For col = 1 To tatolCol
        If headLine = "" Then
            headLine = Chr(34) & XheadData(1, col) & Chr(34)
        Else
            headLine = headLine & Chr(44) & Chr(34) & XheadData(1, col) & Chr(34)
        End If
    Next col
    createFile.writeline (headLine)

    Dim Xdata() As Variant
    ReDim Preserve Xdata(tatolCol)

    Dim dataLine As String
    dataLine = ""

    For row = 2 To tatolRow
        For col = 1 To tatolCol
            If col > 2 And col < 10 Then
                Xdata(col) = Chr(34) & Sheet1.Cells(row, col).Value & Chr(34)
            Else
                Xdata(col) = Sheet1.Cells(row, col).Value
            End If
        Next col

        For item = 1 To UBound(Xdata)
            If dataLine = "" Then
                dataLine = Xdata(item)
            Else
                dataLine = dataLine & Chr(44) & Xdata(item)
            End If
        Next item
        createFile.writeline (dataLine)
        dataLine = ""
    Next row

    MsgBox "CSV出力が完了しました。"

    Range("a1").Select
End Sub