iT邦幫忙

0

VBScript 匯入 csv 檔問題

shadowpeople 2 月前5582 瀏覽

小弟工作上需要透過VBScript(xxx.vbs)來匯入多個CSV檔,但是遇到下述幾個問題請教程式設計的高手幫忙

  1. 要怎樣循環將執行目錄下的多個CSV檔匯入到同一個Excel檔案內,然後用CSV檔名作為Excel檔案中的資料表名稱。
  2. 匯入的CSV檔有個麻煩的問題,裡面是使用"","","",""的方式區分欄位,但是其中有一個欄位內容資料筆數有多行(在Excel開啟時顯示該欄有兩行以上資料,用Notepad++開啟會看到該列資料分成三四行顯示)。
  3. VBScript有辦法匯入上述CSV資料的時候,過程使用陣列或變數的方式來進行嗎?例如讀取CSV檔案的資料,放到A陣列或ABC變數,再寫入EXCEL檔案中(因為寫入EXCEL檔案時順序可能會變成CAB)。

以上,請各位高手指導,謝謝。

ccutmis iT邦新手 1 級 ‧ 2 月前 檢舉
https://stackoverflow.com/questions/39478062/import-multiple-txt-csv-into-one-excel-sheet-but-each-file-in-next-column
shadowpeople iT邦新手 2 級 ‧ 2 月前 檢舉
謝謝您提供連結,但小弟看不太懂 ................. 所以才求助!!

1 個回答

1
xgtcarter
iT邦新手 5 級 ‧ 2 月前

關於多行資料可能要有實際的資料作測試才比較好修改程式去對應
其他的部分已經可以實現,程式是在Excel2013下測試完成的(2007測試也可以)
執行前請先確認VBS同目錄下的CSV目錄是否存在,並將要讀取的CSV檔放置在CSV目錄內

Option Explicit

Const ForReading = 1

Dim strCurPath, strXlsOutput, objExcel, wshFSO, strCsvPath
Dim objCsvFolder, objCsvFile, txtStream, arrStr, x, y, s

strCurPath = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\"))
strCsvPath = strCurPath & "CSV\"
strXlsOutput = strCurPath & "Csv2Excel.xlsx"
Set objExcel = CreateObject("Excel.Application")
Set wshFSO = CreateObject("Scripting.FileSystemObject")
If Not wshFSO.FolderExists(strCsvPath) Then
    Wscript.Echo "CSV Folder : " & vbNewLine & strCsvPath & vbNewLine & "Not Exists!"
    Wscript.Quit
End If
Set objCsvFolder = wshFSO.GetFolder(strCsvPath)
With objExcel
    .Application.Visible = False
    If wshFSO.FileExists(strXlsOutput) Then
        wshFSO.DeleteFile strXlsOutput
    End If
    .Workbooks.Add
    For Each objCsvFile In objCsvFolder.Files
        s = s + 1
        If .Sheets.Count < S Then .Sheets.Add , .Sheets(.Sheets.Count)
        Set txtStream = objCsvFile.OpenAsTextStream(ForReading)
        y = 1
        Do While Not txtStream.AtEndOfStream
            arrStr = Split(txtStream.ReadLine, ",")
            For x = 0 To UBound(arrStr)
                .Sheets(s).Cells(y, x + 1).Value = arrStr(x)
            Next
            y = y + 1
        Loop
        .Worksheets(s).Name = objCsvFile.Name
    Next
    .ActiveWorkbook.SaveAs strXlsOutput
    .ActiveWorkbook.Close
    .Application.Quit
End With
Wscript.Echo "Excel File : " & vbNewLine & strXlsOutput & vbNewLine & " Output OK!"
Set objCsvFolder = Nothing
Set objCsvFile = Nothing
Set objExcel = Nothing
Set wshFSO = Nothing

看更多先前的回應...收起先前的回應...
shadowpeople iT邦新手 2 級 ‧ 2 月前 檢舉

這邊有測試了xgtcarter提供的程式,在分行的部分好像有一些問題。
不過也發現原本的CSV檔中,有空行跟不對稱的資料欄位
還在想辦法處理。

謝謝 xgtcarter 的指導。

xgtcarter iT邦新手 5 級 ‧ 1 月前 檢舉

如果分行有問題的地方沒辦法解決的話,可以把csv檔找個空間上傳上去,
我再根據實際完整的csv檔去做例外排除解析,看是要全放在一個cell還是另外處理,因為當初的script是在沒有實際的csv資料的情況下寫出來的,所以產出的檔案一定會有些落差的.

shadowpeople iT邦新手 2 級 ‧ 1 月前 檢舉

感謝xgtcarter先進這麼熱心的協助,還是您可以提供E-Mail給我,我將範例檔案壓縮寄送讓您看看(17.4K左右)?

xgtcarter iT邦新手 5 級 ‧ 1 月前 檢舉

已私訊我的E-Mail了

xgtcarter iT邦新手 5 級 ‧ 1 月前 檢舉

由於csv內容及格式繁雜,所以可能要確認一下有沒有轉錯的

Option Explicit

Const ForReading = 1

Dim strCurPath, strXlsOutput, objExcel, wshFSO, strCsvPath
Dim objCsvFolder, objCsvFile, txtStream, arrStr, x, y, s
Dim strTmp, strLine

strCurPath = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\"))
strCsvPath = strCurPath & "CSV\"
strXlsOutput = strCurPath & "Csv2Excel.xlsx"
Set objExcel = CreateObject("Excel.Application")
Set wshFSO = CreateObject("Scripting.FileSystemObject")
If Not wshFSO.FolderExists(strCsvPath) Then
    Wscript.Echo "CSV Folder : " & vbNewLine & strCsvPath & vbNewLine & "Not Exists!"
    Wscript.Quit
End If
Set objCsvFolder = wshFSO.GetFolder(strCsvPath)
With objExcel
    .Application.Visible = False
    If wshFSO.FileExists(strXlsOutput) Then
        wshFSO.DeleteFile strXlsOutput
    End If
    .Workbooks.Add
    For Each objCsvFile In objCsvFolder.Files
        s = s + 1
        If .Sheets.Count < S Then .Sheets.Add , .Sheets(.Sheets.Count)
        Set txtStream = objCsvFile.OpenAsTextStream(ForReading)
        y = 1
        Do While Not txtStream.AtEndOfStream
            strLine = txtStream.ReadLine
            If Right(strLine, 1) = Chr(34) And InStrRev(strLine, """,", -1) <> 0 Then
                strLine = strTmp & strLine
                strTmp = vbNullString
                arrStr = Split(Mid(strLine, 2, Len(strLine) - 2), """,""")
                For x = 0 To UBound(arrStr)
                    .Sheets(s).Cells(y, x + 1).Value = arrStr(x)
                Next
                y = y + 1
            Else
                strTmp = strTmp & strLine
            End If
        Loop
        .Worksheets(s).Name = objCsvFile.Name
    Next
    .ActiveWorkbook.SaveAs strXlsOutput
    .ActiveWorkbook.Close
    .Application.Quit
End With
Wscript.Echo "Excel File : " & vbNewLine & strXlsOutput & vbNewLine & " Output OK!"
Set objCsvFolder = Nothing
Set objCsvFile = Nothing
Set objExcel = Nothing
Set wshFSO = Nothing

shadowpeople iT邦新手 2 級 ‧ 1 月前 檢舉

這邊有小測試了一下,是可以轉的,非常感謝xgtcarter大力協助。
不過如果我要變更寫入Excel欄位的順序,我可以透過那個變數(或陣列)來改變呢?謝謝您!!

xgtcarter iT邦新手 5 級 ‧ 1 月前 檢舉

輸出的欄位順序是按照讀入的csv檔的內容順序產生的,沒有把欄位內容讀到獨立的陣列變數中,而是把它直接寫入excel的儲存格中,所以若要改變欄位出現的順序的話,就要從寫入儲存格的順序那邊下手,這可以用choose函數達到這個要求,以下列出有變動的程式碼

Dim strTmp, strLine, xNew
xNew = Choose(x + 1, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18)
.Sheets(s).Cells(y, xNew).Value = arrStr(x) )

欄位的部分可能要依實際輸出欄位數量調整(目前的範例是18),choose後面接的第一個變數是座標(index),後面是你想要的順序,預設就是沒有變動,假設我要把第一個跟第二欄位互換就是改成

xNew = Choose(x + 1, 2, 1, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18)

其它的就依此類推

我要發表回答

立即登入回答