Import CSV to Excel with VBA

  1. 9 bulan yang lalu

    Saya mencoba untuk import data .CSV ke dalam excel, dengan tampilan yang pas. Ini adalah kode yang saya dapat dari searching:

    Sub Macro()
    Dim ws As Worksheet, strFile As String
    
    Set ws = ActiveWorkbook.Sheets("Sheet1")
    
    strFile = Application.GetOpenFilename("Text Files (*.csv),*.csv", , "Please selec text file...")
    With ws.QueryTables.Add(Connection:="TEXT;" & strFile, _
    Destination:=ws.Range("A1"))
        .TextFileParseType = xlDelimited
        .TextFileCommaDelimiter = True
        .Refresh
    End With
      ws.Name = "testing"
    End Sub

    Data dapat masuk ke dalam Excel akan tetapi tidak berada pada baris yang tepat dan tanda_kutip/semi_kolom masih tetap terinpit ke dalam cell.

    Bebas dalam memberikan bahan bacaan, tanggapan dan jawaban. :D

    Mungkin mas @alan13 bisa mencoba script berikut:

    Sub ReadQTCSV()
        Dim ws As Worksheet, strFile As String
        Dim xQT As QueryTable
    
        Set ws = Sheet4
        strFile = Application.GetOpenFilename("Text Files (*.csv),*.csv", , "Please selec text file...")
        Set xQT = ws.QueryTables.Add(Connection:="TEXT;" & strFile, Destination:=ws.Range("A1"))
        With xQT
            .FieldNames = True
            '+-- Sesuaikan dengan jumlah kolom data sumber.
            .TextFileColumnDataTypes = Array(1, 1, 1)
            '+-- Pemisah koma = false.
            .TextFileCommaDelimiter = True
            .TextFileConsecutiveDelimiter = False
            '+-- Pemisah titik koma = true.
            .TextFileSemicolonDelimiter = True
            .TextFileParseType = xlDelimited
            .Refresh
        End With
        
        xQT.Delete
        Set xQT = Nothing
    End Sub

    atau bisa juga mencoba script berikut:

    Sub ReadCSV()
        Dim sFileName As String, sInput As String
        Dim lRow As Long
        Dim xlTarget As Range
        Dim xData
    
        sFileName = Application.GetOpenFilename("Text Files (*.csv),*.csv", , "Please select csv file...")
        
        If Len(sFileName) Then
            lRow = 0
            Set xlTarget = Sheet4.Cells(1, 1)
            Open sFileName For Input As #1
            Do While Not EOF(1)
                Line Input #1, sInput
                '+-- Pemisah dengan titik koma.
                xData = Split(sInput, ";")
                xlTarget.Offset(lRow).Resize(ColumnSize:=UBound(xData) + 1).Value2 = xData
                lRow = lRow + 1
            Loop
            Close #1
        End If
    
    End Sub

    Demikian yang dapat saya bantu... ;)

  2. Caton

    29 Jan 2018 Terverifikasi Jawaban Terpilih Indonesia + 12.014 Poin

    Mungkin mas @alan13 bisa mencoba script berikut:

    Sub ReadQTCSV()
        Dim ws As Worksheet, strFile As String
        Dim xQT As QueryTable
    
        Set ws = Sheet4
        strFile = Application.GetOpenFilename("Text Files (*.csv),*.csv", , "Please selec text file...")
        Set xQT = ws.QueryTables.Add(Connection:="TEXT;" & strFile, Destination:=ws.Range("A1"))
        With xQT
            .FieldNames = True
            '+-- Sesuaikan dengan jumlah kolom data sumber.
            .TextFileColumnDataTypes = Array(1, 1, 1)
            '+-- Pemisah koma = false.
            .TextFileCommaDelimiter = True
            .TextFileConsecutiveDelimiter = False
            '+-- Pemisah titik koma = true.
            .TextFileSemicolonDelimiter = True
            .TextFileParseType = xlDelimited
            .Refresh
        End With
        
        xQT.Delete
        Set xQT = Nothing
    End Sub

    atau bisa juga mencoba script berikut:

    Sub ReadCSV()
        Dim sFileName As String, sInput As String
        Dim lRow As Long
        Dim xlTarget As Range
        Dim xData
    
        sFileName = Application.GetOpenFilename("Text Files (*.csv),*.csv", , "Please select csv file...")
        
        If Len(sFileName) Then
            lRow = 0
            Set xlTarget = Sheet4.Cells(1, 1)
            Open sFileName For Input As #1
            Do While Not EOF(1)
                Line Input #1, sInput
                '+-- Pemisah dengan titik koma.
                xData = Split(sInput, ";")
                xlTarget.Offset(lRow).Resize(ColumnSize:=UBound(xData) + 1).Value2 = xData
                lRow = lRow + 1
            Loop
            Close #1
        End If
    
    End Sub

    Demikian yang dapat saya bantu... ;)

  3. Di sunting 9 bulan yang lalu oleh haidaramzy

    mas caton, sepertinya untuk cara ke dua pada baris
    'xlTarget.Offset(lRow).Resize(ColumnSize:=UBound(xData) + 1).Value2 = xData' mengalami error deh hehe

  4. Caton

    29 Jan 2018 Terverifikasi Indonesia + 12.014 Poin

    @Haidaramzy...

    Bisa dijelaskan dimana dan bagaimana errornya? Pada kedua script di atas, memang tidak saya buatkan Error Trapping agar dapat diketahui dimana dan bagaimana kesalahan yang terjadi. Dengan demikian dapat direvisi kembali scriptnya... :)

  5. Di sunting 9 bulan yang lalu oleh alan13

    Seperti yang dikatakan mas @haidaramzy , saya juga tidak dapat menjalankan cara ke dua. Akan tetapi cara pertama berkerja seperti yang saya harapkan. Jadi saya akan menggunakan cara pertama saja, terimakasih mas @Caton . Lalu saya ingin bertanya lebih lanjut dan masuk ke dalam program yang benar-benar saya ingin buat.

    Sub ReadQTCSV()
        Dim ws As Worksheet, strFile As String
        Dim xQT As QueryTable
    
        Set ws = Sheets.Add(After:=Sheets(Worksheets.Count))
        strFile = Application.GetOpenFilename("Text Files (*.csv),*.csv", , "Please selec text file...")
        Set xQT = ws.QueryTables.Add(Connection:="TEXT;" & strFile, Destination:=ws.Range("A1"))
        With xQT
            .FieldNames = True
            '+-- Sesuaikan dengan jumlah kolom data sumber.
            .TextFileColumnDataTypes = Array(1, 1, 1)
            '+-- Pemisah koma = false.
            .TextFileCommaDelimiter = True
            .TextFileConsecutiveDelimiter = False
            '+-- Pemisah titik koma = true.
            .TextFileSemicolonDelimiter = True
            .TextFileParseType = xlDelimited
            .Refresh
        End With
        ws.Name = txtSheetName.Value
        
        xQT.Delete
        Set xQT = Nothing
    End Sub

    Yang ingin saya tanyakan:

    1. masih ada error di bagian akhir dari program ini: Run-time error: '424': Objext Required. Dan saya tidak tau cara mengatasinya. :D
    2. Bagaimana cara membuat sheet baru memiliki nama yang sama dengan .csv file yang saya import.
    3. Bisakah saya menambahkan looping dan membaca setiap .csv file yang berada pada folder yang sama dengan excel file ini.

    All in All. Bisakah saya menambahkan looping dan membaca setiap .csv file yang berada pada folder yang sama dengan excel file ini lalu mengimport setiap .csv file ke dalam sheet baru dengan nama .csv file yang di import. Dan tidak memiliki Error.

    Sekian terimakasih. :D

  6. Caton

    30 Jan 2018 Terverifikasi Indonesia + 12.014 Poin
    Di sunting 9 bulan yang lalu oleh Caton

    ... masih ada error di bagian akhir dari program ini: Run-time error: '424': Objext Required. Dan saya tidak tau cara mengatasinya...

    Apakah objek txtSheetName ada (eksis) pada script:

    ws.Name = txtSheetName.Value

    — Jika ada, apakah ada isi (nilai) dari properti .Value-nya?
    — Apakah objek tersebut berada pada objek yang dapat diakses oleh prosedur ReadQTCSV?
    — Apakah objek txtSheetName berada di dalam objek ws? Pada saat objek ws dibuat, maka objek ws menjadi objek Sheet yang aktif dan dapat diakses dengan memanggil objek ActiveSheet.
    Banyak lagi kemungkinan penyebab error tersebut. Namun, pada dasarnya hanya ada 1 asal mula error tersebut terjadi, yakni VBA tidak dapat menemukan referensi terhadap objek txtSheetName. Coba hapus baris script tersebut dan jalankan kembali prosedurnya...

    ... Bagaimana cara membuat sheet baru memiliki nama yang sama dengan .csv file yang saya import...

    Coba ganti script:

    ws.Name = txtSheetName.Value

    menjadi:

    ...
        Set xFSO = CreateObject("Scripting.FileSystemObject")
        sSheetName = xFSO.GetBaseName(strFile)
        If Len(sSheetName) > 31 Then
            sSheetName = Left$(sSheetName, 31)
        End If
        ws.Name = sSheetName
    ...

    Catatan: Nama tab sheet tidak dapat lebih dari 31 karakter dan tidak dapat mengandung karakter seperti \ / * [ ] : ?.

    ... Bisakah saya menambahkan looping dan membaca setiap .csv file yang berada pada folder yang sama dengan excel file ini...

    Bisa saja misalnya dengan script seperti berikut:

    Public Sub ReadQTCSV()
        Dim sPathName As String, sFileName As String, sSheetName As String
        Dim xlSheet As Worksheet
        Dim xlQT As QueryTable
        Dim xFSO As Object
        
        Set xFSO = CreateObject("Scripting.FileSystemObject")
        
        sPathName = ThisWorkbook.Path & "\"
        sFileName = Dir(sPathName & "*.csv", vbNormal)
    
        Do While Len(sFileName) > 0
            sFileName = sPathName & sFileName
            Set xlSheet = ThisWorkbook.Worksheets.Add(After:=Sheets(ThisWorkbook.Worksheets.Count))
            Set xlQT = xlSheet.QueryTables.Add(Connection:="TEXT;" & sFileName, Destination:=xlSheet.Range("A1"))
            
            With xlQT
                .FieldNames = True
                .TextFileCommaDelimiter = True
                .TextFileSemicolonDelimiter = True
                .TextFileConsecutiveDelimiter = False
                .TextFileParseType = xlDelimited
                .Refresh
            
                sSheetName = xFSO.GetBaseName(sFileName)
                If Len(sSheetName) > 31 Then
                    sSheetName = Left$(sSheetName, 31)
                End If
                xlSheet.Name = sSheetName
                
                .Delete
            End With
            sFileName = Dir
        Loop
        
        Set xlQT = Nothing
        Set xFSO = Nothing
    End Sub

    Catatan: Script di atas masih tanpa Error Trapping, jadi silahkan ditambahkan sendiri. Kemudian hati-hati jika pada folder terkait ada banyak file CSV. Lebih baik jika script tersebut dibuat dalam objek UserForm dengan tombol pembatal proses, sehingga proses dapat dihentikan kapan saja...

    ... Dan tidak memiliki Error ...

    Pada sebuah artikel, saya pernah membaca kutipan...

    Sebuah program komputer yang baik tidak ditentukan dari ada atau tidak adanya kesalahan (error atau bug) yang terjadi pada program komputer tersebut. Sebuah program komputer yang baik adalah bagaimana program komputer tersebut dirancang untuk dapat menangani kesalahan (error atau bug) yang sedang terjadi atau meminimalisir kemungkinan kesalahan (error atau bug) yang dapat terjadi.

    Membuat program tanpa error sangatlah sulit (bahkan bisa dikatakan mustahil). Demikian... ;)

  7. Nice job sir @Caton .
    Saya dengan tulus mengucapkan terimakasih atas solusi dan penjelasan yang menakjubkan dari anda.
    Dan saya sangat bersyukur dapat menemukan forum berbasis Indonesia yang memiliki member dengan kualitas ini.

    sincerely me @alan13

  8. Caton

    30 Jan 2018 Terverifikasi Indonesia + 12.014 Poin

    Sama-sama mas @Alan13... :)

 

atau Mendaftar untuk ikut berdiskusi!