|
お願い致します。
vba初心者です。
以下のvbaのコードがあるのですが、
選択したCSVファイルのカンマの数を数えて
1レコードに30個カンマが無い場合は
異常CSVなのでメッセージボックスにて
エラーとしたいのですが、現状、マクロエラーとなります。
どう修正して良いのかわかりません。
どなたかご教授下さい。
-----正常CSVデータ----------------------------------------
0,1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9,0 ←正常
0,1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9,0 ←正常
-----異常CSVデータ----------------------------------------
0,1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9,0 ←正常
0,1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9,0 ←正常
0,1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9 ←異常
-----コード-----------------------------------------------
Sub testCSV取込()
Dim FSO As Object, MyCSV As Object
Dim MyF As String, Buf As String
Dim GetR As Long, Flg As Long
Dim i As Long, Acnt As Long, Ucnt As Long, Dcnt As Long
Dim Ary As Variant
With Application
MyF = .GetOpenFilename("CSVファイル(*.csv),*.csv")
If MyF = "False" Then
Exit Sub
Else
.ScreenUpdating = False
End If
End With
Set FSO = CreateObject("Scripting.FileSystemObject")
GetR = FSO.OpenTextFile(MyF, 8).Line
If GetR = 1 Then
MsgBox "ファイルにデータが存在しません。", 48
Set FSO = Nothing: Application.ScreenUpdating = True
Exit Sub
End If
Worksheets("Sheet1").Activate:
Range("A2:K2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Set MyCSV = FSO.OpenTextFile(MyF, 1)
i = 1
Acnt = 0
Ucnt = 0
Dcnt = 0
Flg = 0
Do Until MyCSV.AtEndOfStream
Buf = MyCSV.ReadLine
Ary = Split(Buf, ",")
If Ary(0) = "D07" Then
If Ary(1) = "A" Or Ary(1) = "U" Or Ary(1) = "D" Then
Flg = 1
i = i + 1
Select Case Ary(1)
Case "A":
Acnt = Acnt + 1
Case "U":
Ucnt = Ucnt + 1
Case "D":
Dcnt = Dcnt + 1
End Select
If Ary(9) = 1 Then
Ary(9) = "有"
Else
Ary(9) = ""
End If
If Ary(12) = 1 Then
Ary(12) = "有"
Else
Ary(12) = ""
End If
If Ary(15) = 1 Then
Ary(15) = "有"
Else
Ary(15) = ""
End If
If Ary(18) = 1 Then
Ary(18) = "有"
Else
Ary(18) = ""
End If
If Ary(21) = 1 Then
Ary(21) = "有"
Else
Ary(21) = ""
End If
If Ary(24) = 1 Then
Ary(24) = "有"
Else
Ary(24) = ""
End If
If Ary(27) = 1 Then
Ary(27) = "有"
Else
Ary(27) = ""
End If
If Ary(30) = 1 Then
Ary(30) = "有"
Else
Ary(30) = ""
End If
Cells(i, 1).Resize(, 11).Value = _
Array(Ary(2), Ary(3), Ary(1), Ary(9), _
Ary(12), Ary(15), Ary(18), _
Ary(21), _
Ary(24), Ary(27), Ary(30))
End If
End If
Erase Ary
Loop
MyCSV.Close: Set MyCSV = Nothing
If Flg = 1 Then
i = i - 1
MsgBox "追加(A)データは【" & Acnt & "】件です。" & Chr(13) & _
"更新(U)データは【" & Ucnt & "】件です。" & Chr(13) & _
"削除(D)データは【" & Dcnt & "】件です。" & Chr(13) & Chr(13) & _
"データ抽出総件数は【" & i & "】件です。", 64
MsgBox "データの抽出を終了しました。", 64
Else
MsgBox "対象データは存在しませんでした。", 64
End If
End Sub
|
|