技術標籤：vba取入c's'vcsvvba

vba讀取csv檔案，根據csv檔案不同，會有不同格式：

1. 單純的逗號分割，但是數字或備註欄位中包含逗號，取入時，欄位會被拆分

2. 以逗號分割，但是，每個欄位都有引號

vba讀取入csv後的格式，基本都是字串，然後通過分隔符進行拆分，所以，遇到一個欄位中包含逗號的，很頭疼，但是，根據取入的字串格式，還是有辦法可以解決的

' filePath 檔案路徑
' sheetName 目標sheet頁名
Public Sub inputCsv(filePath As String, sheetName As String)
    Dim Buf As String
    Dim i, j As Long
    Dim tmp2() As Variant
    Dim cnt As Integer
    Dim myflag As Boolean
    
    With Worksheets(sheetName)
        .Visible = xlSheetVisible
        .Activate
        .Cells.Select
        Selection.NumberFormatLocal = "@"
        .Cells(1, 1).Select
    End With
    
    ' 開ける
    Set adoSt = CreateObject("ADODB.Stream")
          
    i = 1
    With adoSt
        .Charset = "Shift-JIS"
        .Open
        .LoadFromFile (filePath)
        Do Until .EOS
            Buf = .Readtext(-2)
            tmp = Split(Buf, ",")
            myflag = False
            cnt = 0
            
            For j = LBound(tmp) To UBound(tmp)
                If myflag = False And Left(tmp(j), 1) = """" And Right(tmp(j), 1) = """" Then
                    cnt = cnt + 1
                    ReDim Preserve tmp2(cnt)
                    tmp2(cnt) = Mid(tmp(j), 2, Len(tmp(j)) - 2)
                
                ElseIf myflag = False And Left(tmp(j), 1) <> """" And Right(tmp(j), 1) <> """" Then
                    cnt = cnt + 1
                    ReDim Preserve tmp2(cnt)
                    tmp2(cnt) = tmp(j)
                
                ElseIf Left(tmp(j), 1) = """" And Right(tmp(j), 1) <> """" Then
                    cnt = cnt + 1
                    ReDim Preserve tmp2(cnt)
                    tmp2(cnt) = Mid(tmp(j), 2, Len(tmp(j)))
                    myflag = True
                
                ElseIf myflag = True And Left(tmp(j), 1) <> """" And Right(tmp(j), 1) <> """" Then
                    tmp2(cnt) = tmp2(cnt) & tmp(j)
                    
                ElseIf myflag = True And Left(tmp(j), 1) <> """" And Right(tmp(j), 1) = """" Then
                    tmp2(cnt) = tmp2(cnt) & Left(tmp(j), Len(tmp(j)) - 1)
                    myflag = False
                End If
                
            Next j
            
            '　書き出し
            For j = 1 To UBound(tmp2)
                Worksheets(sheetName).Cells(i, j).Value = tmp2(j)
            Next j
            
            i = i + 1
        Loop
        .Close
    
    End With
    
    
    'そのままでは數式等が使えなくなるため、書式を標準に戻す
    With Worksheets(sheetName)
        .Cells.Select
        Selection.NumberFormatLocal = "G/標準"
        .Cells(1, 1).Select
        .Visible = xlSheetHidden
    End With
    
    Sheet1.Activate

End Sub
 

執行完上面的方法，csv檔案就已經讀取到sheet頁了

注意，字首0的問題，csv檔案本身文字檔案，如果以excel格式開啟文字，字首0會自動取消，如果以文字格式開啟，則正常，所以，讀取時，不能使用vba的copy方法

業務處理結束後，要輸出csv檔案

' 資産殘高データ変換
'メインロジック
Public Sub Main_sisanZan()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim n As Long
    Dim i As Long
    Dim workFilePath As String
    Dim meisaiRow As Long
    Dim fileName As String
    Dim row As Long
             
    On Error GoTo ERROR_HANDLE
    
    ' tempファイルパス生成
    workFilePath = CreateWorkFile
    ' 出力ファイル名前取得
    fileName = Sheet2.Cells(11, 17).Value
    
    n = FreeFile
    Open workFilePath For Output As #n
    
        ' ループ開始  i = 2 To
        For i = 2 To Worksheets("取込データ").Cells(Rows.Count, 1).End(xlUp).row
            dataCreate n, ws, i
        Next i
    
    Close #n
    
    ' ファイル出力（出力先指定・workファイルのコピー・削除）
    fileOutput workFilePath, fileName, Sheet2.Cells(10, 17).Value
    
    ' 対象ファイルクローズ
    Worksheets("実行").Activate
    Application.ScreenUpdating = True
    
    Exit Sub

ERROR_HANDLE:

    ' workファイル削除
    If (Dir(workFilePath) <> "" And workFilePath <> "") Then
        Close #n
        Kill workFilePath
    End If
    
    ' 対象ファイルクローズ
    If Not wb Is Nothing Then
        wb.Activate
        ActiveWorkbook.Close (False)
    End If
    
    MsgBox "ERROR：" & Err.Description, vbCritical

    Application.ScreenUpdating = True

Exit Sub

NO_DATA:
    ' workファイル削除
    If (Dir(workFilePath) <> "" And workFilePath <> "") Then
        Close #n
        Kill workFilePath
    End If
    
    ' 対象ファイルクローズ
    If Not wb Is Nothing Then
        wb.Activate
        ActiveWorkbook.Close (False)
    End If
    
    MsgBox "データがありません。", vbCritical
    
    Application.ScreenUpdating = True
    
End Sub


' ワークファイルパス生成
Public Function CreateWorkFile() As String
    Dim filePath
    Dim fso As Object
    
    ChDrive Left(ThisWorkbook.Worksheets("環境設定").Range("Q10"), 1)
    ChDir ThisWorkbook.Worksheets("環境設定").Range("Q10")
    
    ' WindowsScriptingHostによるファイルパス取得
    Set fso = CreateObject("Scripting.FileSystemObject")
    filePath = fso.GetAbsolutePathName("$$Workfile.tmp")
    
    CreateWorkFile = filePath
       
End Function


' CSV出力処理
' rowNum 取込データrow number
Private Sub dataCreate(intFF As Long, ws As Worksheet, rowNum As Long)
    ' 変數宣言部
    Dim xlsRow(1 To 237) As String    ' CSV各カラムへのセット値
    Dim outText As String               ' CSV各行のテキスト
    Dim i, j, row As Integer                  ' カウンタ
    Dim sisanNo As String
    
    On Error GoTo ERROR_CHECK
    
    ' 資産番號　sheet3は取込データ
    sisanNo = Sheet3.Cells(rowNum, 4).Value
    
    For i = 1 To 237

        Select Case i
        Case 4
            ' 會社コード
            xlsRow(i) = Sheet6.Range("Q3").Value
        Case 7
            If sisanNo <> "" And InStr(sisanNo, "-") > 0 Then
                ' 資産コード
                xlsRow(i) = Trim(Left(sisanNo, InStr(sisanNo, "-") - 1))
            Else
                xlsRow(i) = ""
            End If
        Case Else
            xlsRow(i) = Sheet7.Cells(3, i).Value    'sheet7は出力テンプレート
        End Select
    Next i
        
    ' ファイルへ出力
    ' 各カラムをカンマで連結
    outText = xlsRow(1)
    For i = 2 To 237
        outText = outText & "," & xlsRow(i)
    Next i
    
    ' レコードを出力
    Print #intFF, outText
    
    Exit Sub

ERROR_CHECK:

    MsgBox "sub: dataCreate(),第 " & i & " 個フィールダ" & vbCrLf & _
            "実行時エラー’" & Err.Number & "’：" & vbCrLf & _
             Err.Description, vbCritical
    
    Exit Sub
    
End Sub


' temp file
' fileName output file name
' savePath output file path
' ファイル出力（出力先指定・workファイルのコピー・削除）
Public Sub fileOutput(workFilePath As String, fileName As String, savePath As String)
    Dim msgrtn As Long
    Dim outputFilePath As String
    
    ' 設定出力ファイル名前とパース
    If Right(savePath, 1) <> "\" Then
        outputFilePath = savePath & "\" & fileName '拡張子が「環境設定」で專案チェック
    Else
        outputFilePath = savePath & fileName
    End If
    
    ' ファイルコピー＆リネーム
    'If outputFilePath <> False Then
        If Dir(outputFilePath) <> "" Then
            msgrtn = MsgBox("ファイルが存在します。上書きしますか？", vbOKCancel)
            If msgrtn = vbOK Then
                Kill outputFilePath
                FileCopy workFilePath, outputFilePath
            End If
        Else
            FileCopy workFilePath, outputFilePath
        End If
    'End If
    
    ' ワークファイル削除
    Kill workFilePath
End Sub
 

至此，在指定路徑下會有指定檔名的出力csv檔案。

注：1. 每個方法強烈建議使用“on error goto xxx”,類似於在java程式設計中的捕捉異常

2. 呼叫方法需要傳參，該引數必須單獨宣告，否則提示型別不匹配

3. 儘量debug吧，別太相信自己