xls檔轉換為csv檔

礙於工作上需要直接讀取csv檔

但一個Excel的xls檔案卻有很多個sheets

要一個一個存為csv檔實在太浪費時間

所以小弟參考各方資料，寫了這個小功能~

※ 有1~1023列，但每一列不一定有填入產品

※ 我們希望最後Output的.csv檔，僅呈現針對產品篩選完的形式

Note: 要使用該段程式碼前，要先引用"Microsoft Excel 14.0 Object Libarary"！！

Part 1: Convert部份

'Add Microsoft Excel 14.0 Object Libarary to references

Sub XlsToCsv_Click()

    Set xls = CreateObject("Excel.Application")
    xls.Visible = True 'comment this out if you don't want excel to show
    tmp = Dir(App.Path & "\*.xls")

    Do While tmp <> ""
        xls.DisplayAlerts = False
        
        xls.Workbooks.Open App.Path & "\" & tmp
        
        '※將空白的產品欄位篩選掉(第2欄)
        For i = 1 To xls.Worksheets.Count
            With xls
                
                'Step1: 先判斷此sheet是否有篩選。Yes→此範圍取消篩選；No→跳過此判斷
                .Sheets(i).Activate
                If .Sheets(i).FilterMode = True Then
                    tmpRow = .Sheets(i).Range("A65536").End(xlUp).Row
                    tmpCol = .Sheets(i).Range("IV1").End(xlToLeft).Column
                    .Sheets(i).Range(.Cells(1, "A"), .Cells(tmpRow, tmpCol)).AutoFilter
                End If
                
                'Step2: 針對「產品」欄位進行篩選(濾掉空白的部份)
                cntRow = .Sheets(i).Range("A65536").End(xlUp).Row
                cntCol = .Sheets(i).Range("IV1").End(xlToLeft).Column
                .Sheets(i).Range(.Cells(1, "A"), .Cells(cntRow, cntCol)).AutoFilter Field:=2, Criteria1:="<>", Operator:=xlFilterValues   '把空格篩選掉(沒有填產品的空格)
                
                'Step3: 把篩選出來的部份複製出來，然後再刪除原來的部份
                cntRow2 = .Sheets(i).Range("A65536").End(xlUp).Row
                .Sheets(i).Range(.Cells(1, "A"), .Cells(cntRow2, cntCol)).Copy Destination:=xls.Sheets(i).Range("A" & cntRow + 1)
                .Sheets(i).Range(.Cells(1, "A"), .Cells(cntRow, cntCol)).AutoFilter
                .Sheets(i).Rows("1:" & cntRow).Delete Shift:=xlUp
                
            End With
        Next i
                    
        '※將此檔案的工作表全部各別存為.csv檔   (Worksheets.Count: 總sheet數量)
        For i = 1 To xls.Worksheets.Count
            xls.Sheets(i).SaveAs FileName:=Replace(App.Path & "\" & xls.Sheets(i).Name, ".xls", ".csv"), FileFormat:=xlCSV, CreateBackup:=False
        Next i
        
        
        xls.Workbooks.Close
        tmp = Dir
        
        xls.DisplayAlerts = True
    Loop

    xls.Quit

    MsgBox "轉換完成！", vbInformation, ""

End Sub

Part2: 清除目錄下所有.csv檔

Sub Clear_Click()
    
    Response = MsgBox("確定要清除資料夾內的.csv檔案嗎？", vbYesNo, "Clear .csv")
    
    Select Case Response
        Case vbYes
            GoTo Clear
        Case vbNo
            Exit Sub
    End Select

Clear:
    If Dir(App.Path & "\*.csv", vbDirectory) = "" Then
        MsgBox ".csv檔不存在！", vbInformation, "錯誤訊息"
        Exit Sub
    Else
        Kill App.Path & "\*.csv"      '刪除資料夾下的.csv檔
    End If
    
    MsgBox ".csv檔案已清除！", vbInformation, ""
    
End Sub

按下Convert後，即可輸出每個sheet對應的csv檔 (如下圖)

打開Table3，內容確實僅有篩選過的資料，大功告成~~

範例檔案：XlsToCsv_20180618