VBA CSV格式的解析類 【c語言CSV Parser轉換】


  1 Option Explicit
  2 '----------------讀Csv文件 類---------------------
  3 
  4 Private Declare Function WideCharToMultiByte Lib "kernel32" _
  5     (ByVal CodePage As Long, _
  6      ByVal dwFlags As Long, _
  7      ByVal lpWideCharStr As Long, _
  8      ByVal cchWideChar As Long, _
  9      ByRef lpMultiByteStr As Any, _
 10      ByVal cchMultiByte As Long, _
 11      ByVal lpDefaultChar As String, _
 12      ByVal lpUsedDefaultChar As Long) As Long
 13 
 14 Private Declare Function MultiByteToWideChar Lib "kernel32" _
 15     (ByVal CodePage As Long, _
 16      ByVal dwFlags As Long, _
 17      ByRef lpMultiByteStr As Any, _
 18      ByVal cchMultiByte As Long, _
 19      ByVal lpWideCharStr As Long, _
 20      ByVal cchWideChar As Long) As Long
 21      
 22 Private Type BuffType '一個緩沖區
 23     StartPosAbso As Long '該緩沖區在文件中的絕對位置
 24     BufLen As Long  '緩沖區總長
 25     PtrInBuf As Long '緩沖區內部指針
 26     ptrNextStrStartInBuf As Long '下一行內容開始位置(從此處算到下一個cr/lf為下一行)
 27     IgnoreFirstLf As Boolean '是否忽略本緩沖區的第一個 vblf
 28     bufBytes() As Byte '緩沖區內容(字節數組)
 29 End Type
 30 
 31 
 32 Dim State As StateType
 33 Private Enum StateType
 34     NewFieldStart
 35     NonQuotesField
 36     QuotesField
 37     FieldSeparator
 38     QuoteInQuotesField
 39     RowSeparator
 40     ErrorS
 41 End Enum
 42 
 43 Dim af_Buff As BuffType '一個緩沖區
 44 Dim af_lngFileLength As Long
 45 
 46 Dim lFileName As String
 47 Dim lFileNum As Integer
 48 Dim lStatus As Integer '-1=已關閉;1=已打開;2=已經開始讀取;0=未設
 49 Dim lIsEndRead As Boolean '=true表示或者讀完文件或者出錯,即不能再繼續讀了,主程序應退出讀取
 50 Dim lErrOccured As Boolean '是否上次 GetNextLine 發生了一個錯誤
 51 Dim lAutoOpen As Boolean '是否設置 FileName 屬性時自動打開文件,默認為true(類初始化時設為true)
 52 Dim lAutoClose As Boolean '是否 讀取行讀完文件或出錯時 自動關閉文件,默認為true(類初始化時設為true)
 53 
 54 
 55 
 56 
 57 Dim lEncode As Long '編碼設置
 58 Dim EncodeErr As Boolean '編碼轉換時出錯Flag
 59 Public Enum EncodeEnum
 60     Default = 0
 61     ShifJis = 932
 62     JIS = 50220
 63     Utf8 = 65001
 64     GB2312 = 936
 65 End Enum
 66 
 67 
 68 Dim ch As Long
 69 '以上僅為GetNextLine函數用,為了不每次調用GetNextLine時候都重新定義,故將之做為全局的了,其實應是局部的
 70 '_______________________________________
 71 Dim lineArr As New Collection
 72 Dim strArr() As Byte
 73 Dim strArrlBuff As Long
 74 Private Const mcInitBuffSize As Long = 100 '初始分配空間大小,10K
 75 
 76 Public Function GetNextLine(ByRef col As Collection) As Integer
 77     '讀取文件的下一行文本,支持 vbCrLf、vbLf、vbCr 的多種分行符
 78     '返回1表示正常讀取了
 79     '返回-1也表示正常,但讀完了文件
 80     '返回0表示出錯或非法
 81     '1. 一般出錯返回0,並設置 lErrOccured=True
 82     '2. 如果上次讀完了文件,則允許再額外調用一次 GetNextLine (返回 0 並 _
 83       不提示出錯,lErrOccured 仍為 false,此算非法);如果再調用就出錯了 _
 84       (函數仍返回0,但 lErrOccured 為 true 此算出錯)
 85 
 86 
 87     '設置反映錯誤的標志變量
 88     lErrOccured = False '表示尚未發生錯誤;如后續程序中發生了錯誤再改為 True
 89     '判斷和設置狀態
 90     If lStatus = 0 Then
 91         'lStatus = 0:當前狀態非法,尚未打開文件,無法讀取
 92         GoTo errExit
 93     ElseIf lStatus < 0 Then
 94         GoTo errExit '不允許額外調用了,出錯
 95     End If
 96     
 97     '正常讀取的情況:此時 lStatus 要么為1要么為2,即要么文件已經打開, _
 98       '要么已經進入讀取狀態了,總之讀取下一行是沒有問題的
 99     lStatus = 2 '設置為2表示已經進入讀取狀態
100     
101     
102     '//////////////// 讀取文件,以找到“一行”的內容 ////////////////
103     On Error GoTo errExit  '有任何錯誤發生時都轉到errExit標簽處執行
104     
105     With af_Buff
106         '緩沖區逐漸沿文件前進,直到緩沖區起始位置超過文件總長讀完文件
107         Do Until .StartPosAbso > af_lngFileLength
108         
109             '============ (1)根據需要讀取文件的下一個緩沖區內容 ============
110             '若 .PtrInBuf=-1 表示要讀取下一個緩沖區,否則不讀取下一個,仍使用 _
111               當前緩沖區和 .PtrInBuf 指針
112             If .PtrInBuf < 0 Then
113                 '----從 .StartPosAbso 開始讀取一些字節存入緩沖區 .bufBytes()
114                 .BufLen = FileGetBytesLocal(.StartPosAbso, .bufBytes())
115                 If .BufLen <= 0 Then GoTo errExit '讀取出錯
116                 
117                 '----初始化緩沖區指針
118                 .PtrInBuf = 1
119                 '看是否需要忽略第一個 vbLf
120                 If .IgnoreFirstLf Then
121                     If .bufBytes(.PtrInBuf) = 10 Then '第1個字節確是 vbLf
122                         '忽略第一個 vbLf
123                         .PtrInBuf = .PtrInBuf + 1
124                     End If 'If .bufBytes(.PtrInBuf) = 10 Then
125                     
126                     .IgnoreFirstLf = False '恢復標志,不忽略第一個 vbLf
127                 End If 'If .IgnoreFirstLf Then
128                 
129                 '初始化下一行起始位置 ptrNextStrStartInBuf (下一行內容包含該字節)
130                 .ptrNextStrStartInBuf = .PtrInBuf
131             End If 'If .PtrInBuf < 0 Then
132             
133             '============ (2)逐個掃描緩沖區中的字節,查找分行符 ============
134             '掃描緩沖區中的字節,直到找到 vbCr或vbLf 或掃描完緩沖區
135             For .PtrInBuf = .PtrInBuf To .BufLen
136                 ch = .bufBytes(.PtrInBuf)
137                 Select Case State '34代表雙引號 44代表逗號
138                     Case NewFieldStart
139                         If ch = 34 Then
140                             State = QuotesField
141                         ElseIf ch = 44 Then
142                             lineArr.Add ""
143                             State = FieldSeparator
144                         ElseIf ch = 13 Or ch = 10 Then
145                             State = NewFieldStart
146                             Exit For
147                         Else
148 
149                             strArrlBuff = strArrlBuff + 1
150                             If strArrlBuff Mod mcInitBuffSize = 0 Then
151                                 ReDim Preserve strArr(1 To strArrlBuff + mcInitBuffSize)
152                             End If
153                             'ReDim Preserve strArr(1 To strArrlBuff)
154                             strArr(strArrlBuff) = ch
155                             'strArr.Add ch
156                             State = NonQuotesField
157                         End If
158                     Case NonQuotesField
159                         If ch = 44 Then
160                             lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) '代碼轉換 strArr
161                             Erase strArr
162                             ReDim strArr(1 To mcInitBuffSize)
163                             strArrlBuff = 0
164                             'Set strArr = New Collection
165                             State = FieldSeparator
166                         ElseIf ch = 13 Then
167                             lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) '代碼轉換 strArr
168                             State = RowSeparator
169                         Else
170                             strArrlBuff = strArrlBuff + 1
171                             If strArrlBuff Mod mcInitBuffSize = 0 Then
172                                 ReDim Preserve strArr(1 To strArrlBuff + mcInitBuffSize)
173                             End If
174                             'ReDim Preserve strArr(1 To strArrlBuff)
175                             strArr(strArrlBuff) = ch
176                             'strArr.Add ch
177                         End If
178                     Case QuotesField
179                         If ch = 34 Then
180                             State = QuoteInQuotesField
181                         Else
182                             strArrlBuff = strArrlBuff + 1
183                             If strArrlBuff Mod mcInitBuffSize = 0 Then
184                                 ReDim Preserve strArr(1 To strArrlBuff + mcInitBuffSize)
185                             End If
186                             'ReDim Preserve strArr(1 To strArrlBuff)
187                             strArr(strArrlBuff) = ch
188                             'strArr.Add ch
189                         End If
190                     Case FieldSeparator
191                         If ch = 44 Then
192                             lineArr.Add ""
193                         ElseIf ch = 34 Then
194                             Erase strArr
195                             ReDim strArr(1 To mcInitBuffSize)
196                             strArrlBuff = 0
197                             'Set strArr = New Collection
198                             State = QuotesField
199                         ElseIf ch = 13 Then
200                             lineArr.Add ""
201                             State = RowSeparator
202                         Else
203                             strArrlBuff = strArrlBuff + 1
204                             If strArrlBuff Mod mcInitBuffSize = 0 Then
205                                 ReDim Preserve strArr(1 To strArrlBuff + mcInitBuffSize)
206                             End If
207                             'ReDim Preserve strArr(1 To strArrlBuff)
208                             strArr(strArrlBuff) = ch
209                             'strArr.Add ch
210                             State = NonQuotesField
211                         End If
212                     Case QuoteInQuotesField
213                         If ch = 44 Then
214                             lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) '代碼轉換 strArr
215                             Erase strArr
216                             ReDim strArr(1 To mcInitBuffSize)
217                             strArrlBuff = 0
218                             'Set strArr = New Collection
219                             State = FieldSeparator
220                         ElseIf ch = 13 Then
221                             lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) '代碼轉換 strArr
222                             State = RowSeparator
223                         ElseIf ch = 34 Then
224                             strArrlBuff = strArrlBuff + 1
225                             If strArrlBuff Mod mcInitBuffSize = 0 Then
226                                 ReDim Preserve strArr(1 To strArrlBuff + mcInitBuffSize)
227                             End If
228                             'ReDim Preserve strArr(1 To strArrlBuff)
229                             strArr(strArrlBuff) = ch
230                             'strArr.Add ch
231                             State = QuotesField
232                         Else
233                             State = ErrorS '"語法錯誤: 轉義字符 \" 不能完成轉義 或 引號字段結尾引號沒有緊貼字段分隔符";
234                         End If
235                     Case RowSeparator
236                         If ch = 10 Then
237                             Erase strArr
238                             ReDim strArr(1 To mcInitBuffSize)
239                             strArrlBuff = 0
240                             'Set strArr = New Collection
241                             State = NewFieldStart
242                             Exit For
243                         Else
244                             State = ErrorS '"語法錯誤: 行分隔用了回車 \\r。但未使用回車換行 \\r\\n ";
245                         End If
246                     Case ErrorS
247                         GoTo errExit
248                                             
249                 End Select
250 
251 '                If .bufBytes(.PtrInBuf) = 13 Or _
252 '                 .bufBytes(.PtrInBuf) = 10 Then Exit For
253             Next .PtrInBuf
254             
255             '退出 For 后,判斷是否找到了分行符 vbCr或vbLf
256             If .PtrInBuf <= .BufLen Then  '是否找到了 vbCr或vbLf
257                 If .PtrInBuf + 1 > .BufLen And _
258                   .StartPosAbso + .BufLen > af_lngFileLength Then
259                     '已經讀完文件
260                     lIsEndRead = True
261                     If lAutoClose Then CloseFile
262                 Else
263                     '還未讀完文件,再判斷是否文件只剩一個字節;若只剩一個字節並且 _
264                       '剩下的正好是 vbLf,並且下次要忽略掉 vbLf,則仍是已經讀完文件
265                     If .StartPosAbso + .BufLen = af_lngFileLength And .IgnoreFirstLf Then
266                         '讀取文件中的最后一個字節,只測試一下
267                         Dim tByt() As Byte, tRet As Integer
268                         tRet = FileGetBytesLocal(.StartPosAbso + .BufLen, tByt())
269                         If tRet <= 0 Then GoTo errExit '出錯處理
270                         If tByt(1) = 10 Then
271                             '已經讀完文件
272                             lIsEndRead = True
273                             If lAutoClose Then CloseFile
274                         End If
275                     End If
276                 End If
277                 .PtrInBuf = .PtrInBuf + 1
278             
279                 If lIsEndRead Then
280                     '已經讀完文件,一定 Exit Function
281                     
282                     Set col = lineArr
283                     Set lineArr = New Collection
284                     strArrlBuff = 0
285                     GetNextLine = 0
286                     
287                     Exit Function '已經讀完文件,一定 Exit Function
288                 Else 'If lIsEndRead Then
289                     '沒有讀完文件(忽略空行不退出,否則退出)
290                         If GetNextLine = 0 Then
291                         '不需要忽略空行或最后不是空行,退出
292                         Else
293                             Set col = lineArr
294                             Set lineArr = New Collection
295                             strArrlBuff = 0
296                             GetNextLine = 1
297                             Exit Function
298                         End If
299                 End If 'If lIsEndRead Then
300                 
301             Else 'If .PtrInBuf <= .BufLen Then '是否找到了 vbCr或vbLf
302                  
303                  .PtrInBuf = -1
304                 '==== 准備繼續讀下一個緩沖區 ====
305                 .StartPosAbso = .StartPosAbso + .BufLen
306             End If 'If .PtrInBuf <= .BufLen Then '是否找到了 vbCr或vbLf
307         Loop
308     End With
309     
310     
311     '//////////// 全部讀完文件,看還有無剩余的 ////////////
312    
313         
314         Select Case State
315             Case NonQuotesField
316                  lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) '代碼轉換 strArr
317                  Erase strArr
318                  ReDim strArr(1 To mcInitBuffSize)
319                  strArrlBuff = 0
320                  'lineArr.Add strArr
321                  'Set strArr = New Collection
322             Case QuotesField
323                  GoTo errExit '"語法錯誤: 引號字段未閉合";
324             Case FieldSeparator
325                 lineArr.Add ""
326             Case QuoteInQuotesField
327                 lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) '代碼轉換 strArr
328                 
329         End Select
330         
331 
332         Set col = lineArr
333         Set lineArr = New Collection
334         strArrlBuff = 0
335 
336         GetNextLine = 0
337 
338         
339         If lAutoClose Then CloseFile
340         lIsEndRead = True
341         '此時讀完文件,必須返回
342         Exit Function
343 
344     
345 
346 errExit:
347     lErrOccured = True
348     GetNextLine = 0
349     '為一般錯誤,不設置 lIsEndRead = True
350     If lAutoClose Then CloseFile
351 End Function
352 
353 Private Function EncodeStr(ByRef bytIn() As Byte, hasError As Boolean, Optional byteSize As Long = -1) As String
354 
355     Select Case Encode
356         Case Default
357             Dim tempStr As String
358             tempStr = bytIn
359             EncodeStr = StrConv(tempStr, vbUnicode)
360 
361         Case ShifJis
362             EncodeStr = WCMB_Decode(ShifJis, bytIn, hasError, byteSize)
363         Case JIS
364              EncodeStr = WCMB_Decode(JIS, bytIn, hasError, byteSize)
365         Case Utf8
366             EncodeStr = WCMB_Decode(Utf8, bytIn, hasError, byteSize)
367         Case GB2312
368              EncodeStr = WCMB_Decode(GB2312, bytIn, hasError, byteSize)
369     End Select
370 
371 End Function
372 
373 
374 ' 関數名    : WCMB_Decode
375 ' 返り値    : UNICODE文字列
376 ' 引き數    : cp    : 入力文字データのコードページ番號
377 '           : bytIn : 入力文字データ
378 ' 機能説明  : 入力文字データをUNICODEに変換する
379 ' 備考      : MultiByteToWideCharによる文字コード変換
380 Private Function WCMB_Decode(ByVal cp As Long, ByRef bytIn() As Byte, ByRef hasError As Boolean, Optional byteSize As Long = -1) As String
381     On Error GoTo ErrHandler
382 
383     Dim lngInSize As Long
384     Dim strBuf As String
385     Dim lngBufLen As Long
386     Dim lngRtn As Long
387     If byteSize > 0 Then
388         lngInSize = byteSize
389     Else
390         If bytIn(UBound(bytIn)) = 13 Then
391             lngInSize = UBound(bytIn) - 1
392         Else
393             lngInSize = UBound(bytIn)
394         End If
395     End If
396     lngBufLen = (lngInSize + 1) * 5
397     strBuf = String$(lngBufLen, vbNullChar)
398     lngRtn = MultiByteToWideChar _
399         (cp, 0, bytIn(1), lngInSize, StrPtr(strBuf), lngBufLen)
400     If lngRtn Then
401         WCMB_Decode = Left$(strBuf, lngRtn)
402     End If
403     hasError = False
404     Exit Function
405 ErrHandler:
406     WCMB_Decode = ""
407     hasError = True
408 End Function
409 
410 Public Sub Init()
411 
412     ReDim strArr(1 To mcInitBuffSize) 'CSV 各個單元 緩沖區
413     strArrlBuff = 0
414                  
415     Erase af_Buff.bufBytes '緩沖區
416     
417     
418 
419     af_lngFileLength = 0
420     af_Buff.StartPosAbso = 1 '當前緩沖區的起始處所在的文件位置
421     af_Buff.ptrNextStrStartInBuf = 1
422     
423     '此作為標志,=-1表示下次運行 GetNextLine 要重新讀取新的緩沖區 _
424       '否則不重新讀取,仍使用當前緩沖區和 .PtrInBuf 指針
425     af_Buff.PtrInBuf = -1
426     
427     lErrOccured = False
428 
429     
430     af_Buff.IgnoreFirstLf = False '初始化標志:當前緩沖區不需要忽略第一個字節(若是vblf)
431     
432     lIsEndRead = False
433 End Sub
434 
435 Public Function GetPercent(Optional DotNum As Integer = 2) As Single
436     'DotNum保留幾位小數,<0或>7為不保留小數
437     Dim sngPerc As Single
438     
439     If af_lngFileLength > 0 Then
440         If af_Buff.PtrInBuf < 0 Then
441             sngPerc = (af_Buff.StartPosAbso - 1) / af_lngFileLength
442         Else
443             sngPerc = (af_Buff.StartPosAbso + af_Buff.PtrInBuf - 2) / af_lngFileLength
444         End If
445     End If
446     
447     If DotNum >= 0 Or DotNum <= 7 Then
448         Dim Temp As Long
449         Temp = 10 ^ DotNum
450         sngPerc = Int(Temp * sngPerc + 0.5) / Temp
451     End If
452     
453     GetPercent = sngPerc
454 End Function
455 
456 Public Sub CloseFile()
457     If lFileNum > 0 Then Close lFileNum: lFileNum = 0
458     lStatus = -1 '表示文件已關閉
459     '不Init,防止讀取行后自動關閉文件時狀態變量被初始化;在OpenFile時會Init
460 End Sub
461 
462 Public Function OpenFile() As Boolean
463     If lFileNum > 0 Then CloseFile '如果已打開了文件,則先關閉它
464     lFileNum = FreeFile '獲得一個可用的文件號(同時屬性 FileNum 的值也自動改變)
465     On Error GoTo errH '如果一下程序發生任何錯誤,就轉到 errH 標簽處執行
466     If Dir(lFileName, 31) = "" Then GoTo errH '如果文件不存在,就轉到 errH 標簽處執行
467     Open lFileName For Binary Access Read As #lFileNum '以二進制方式打開文件
468     lStatus = 1 '表示文件已打開
469     Init '初始化操作
470     af_lngFileLength = LOF(lFileNum) '設置文件總大小
471     OpenFile = True
472     Exit Function
473 errH:
474     If lFileNum > 0 Then CloseFile
475     OpenFile = False
476 End Function
477 
478 
479 
480 Private Function FileGetBytesLocal(ByVal ReadPos As Long, _
481                                          ArrBytes() As Byte, _
482                           Optional ByVal EndingBorder As Long = 0, _
483                           Optional ByVal ReadMax As Long = 16384) As Long
484                           'Optional ByVal ReadMax As Long = 16384, _
485     '從文件號 lFileNum 中的 ReadPos 位置開始讀取一批字節
486     '從參數ArrBytes()返回讀取的字節內容,會重新定義ArrBytes()數組
487     '所讀取的字節數不確定,如果文件中有足夠的內容,就讀取ReadMax個字節, _
488       '否則就讀到文件尾(當EndingBorder參數<=0時)或讀到EndingBorder _
489       '為止(當EndingBorder參數>0時)
490     'ShowResume 指定如果讀取出錯,是否彈出對話框提示
491       '若ShowResume=1,提示框中有"重試"和"取消"兩個按鈕;
492       '若ShowResume=2,出錯時提示框中有"終止"、"重試"和"忽略"三個按鈕;
493       '若ShowResume=0,出錯時不彈出提示框,不彈出提示框就不能在發生錯誤時重試
494     '返回讀取的字節數,若失敗返回<=0,若用戶“忽略”則返回=0;_
495       '若用戶終止或取消或無提示框,則返回<0
496     
497     Dim lngUBound As Long
498     
499     If EndingBorder <= 0 Then EndingBorder = LOF(lFileNum)
500     If EndingBorder < ReadPos Then
501         FileGetBytesLocal = -1
502         Exit Function
503     End If
504     
505     On Error GoTo errH
506     If EndingBorder - ReadPos + 1 >= ReadMax Then lngUBound = ReadMax Else _
507       lngUBound = EndingBorder - ReadPos + 1
508     
509     ReDim ArrBytes(1 To lngUBound) As Byte
510     
511     Get #FileNum, ReadPos, ArrBytes
512 
513     FileGetBytesLocal = lngUBound
514     Exit Function
515 errH:
516      FileGetBytesLocal = -1
517 End Function
518 
519 
520 
521 Private Sub Class_Initialize()
522     lAutoOpen = True '設置 FileName 屬性時自動打開文件
523     lAutoClose = True '讀取行讀完文件或出錯時 自動關閉文件
524 End Sub
525 
526 Private Sub Class_Terminate()
527     CloseFile
528     Erase af_Buff.bufBytes
529 
530 End Sub
531 
532 
533 Public Property Get FileName() As String
534     FileName = lFileName
535 End Property
536 
537 Public Property Let FileName(ByVal vNewValue As String)
538     If lFileNum > 0 Then CloseFile
539     lFileName = vNewValue
540     If lAutoOpen Then OpenFile
541 End Property
542 
543 Public Property Get FileNum() As Integer
544     FileNum = lFileNum
545 End Property
546 
547 Public Property Get Status() As Integer
548     Status = lStatus
549 End Property
550 
551 Public Property Get IsEndRead() As Boolean
552     IsEndRead = lIsEndRead
553 End Property
554 
555 Public Property Get AutoOpen() As Boolean
556     AutoOpen = lAutoOpen
557 End Property
558 
559 Public Property Let AutoOpen(ByVal vNewValue As Boolean)
560     lAutoOpen = vNewValue
561 End Property
562 
563 Public Property Get AutoClose() As Boolean
564     AutoClose = lAutoClose
565 End Property
566 
567 Public Property Let AutoClose(ByVal vNewValue As Boolean)
568     lAutoClose = vNewValue
569 End Property
570 
571 
572 Public Property Get ErrOccured() As Boolean
573     ErrOccured = lErrOccured
574 End Property
575 
576 Public Property Let ErrOccured(ByVal vNewValue As Boolean)
577     lErrOccured = vNewValue
578 End Property
579 
580 Public Property Get Encode() As EncodeEnum
581     Encode = lEncode
582 End Property
583 
584 Public Property Let Encode(ByVal vNewValue As EncodeEnum)
585     lEncode = vNewValue
586 End Property
587 
588 Public Property Get IsEncodeErr() As Boolean
589     IsEncodeErr = EncodeErr
590 End Property
只解析Item

 

  1 Option Explicit
  2 '----------------讀Csv文件 類---------------------
  3 
  4 Private Declare Function WideCharToMultiByte Lib "kernel32" _
  5     (ByVal CodePage As Long, _
  6      ByVal dwFlags As Long, _
  7      ByVal lpWideCharStr As Long, _
  8      ByVal cchWideChar As Long, _
  9      ByRef lpMultiByteStr As Any, _
 10      ByVal cchMultiByte As Long, _
 11      ByVal lpDefaultChar As String, _
 12      ByVal lpUsedDefaultChar As Long) As Long
 13 
 14 Private Declare Function MultiByteToWideChar Lib "kernel32" _
 15     (ByVal CodePage As Long, _
 16      ByVal dwFlags As Long, _
 17      ByRef lpMultiByteStr As Any, _
 18      ByVal cchMultiByte As Long, _
 19      ByVal lpWideCharStr As Long, _
 20      ByVal cchWideChar As Long) As Long
 21      
 22 Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
 23 Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (ptr() As Any) As Long
 24 
 25 Private Type BuffType '一個緩沖區
 26     StartPosAbso As Long '該緩沖區在文件中的絕對位置
 27     BufLen As Long  '緩沖區總長
 28     PtrInBuf As Long '緩沖區內部指針
 29     ptrNextStrStartInBuf As Long '下一行內容開始位置(從此處算到下一個cr/lf為下一行)
 30     IgnoreFirstLf As Boolean '是否忽略本緩沖區的第一個 vblf
 31     bufBytes() As Byte '緩沖區內容(字節數組)
 32 End Type
 33 
 34 
 35 Dim State As StateType
 36 Private Enum StateType
 37     NewFieldStart
 38     NonQuotesField
 39     QuotesField
 40     FieldSeparator
 41     QuoteInQuotesField
 42     RowSeparator
 43     ErrorS
 44 End Enum
 45 
 46 Dim af_Buff As BuffType '一個緩沖區
 47 Dim af_lngFileLength As Long
 48 
 49 Dim lFileName As String
 50 Dim lFileNum As Integer
 51 Dim lStatus As Integer '-1=已關閉;1=已打開;2=已經開始讀取;0=未設
 52 Dim lIsEndRead As Boolean '=true表示或者讀完文件或者出錯,即不能再繼續讀了,主程序應退出讀取
 53 Dim lErrOccured As Boolean '是否上次 GetNextLine 發生了一個錯誤
 54 Dim lAutoOpen As Boolean '是否設置 FileName 屬性時自動打開文件,默認為true(類初始化時設為true)
 55 Dim lAutoClose As Boolean '是否 讀取行讀完文件或出錯時 自動關閉文件,默認為true(類初始化時設為true)
 56 
 57 
 58 
 59 
 60 Dim lEncode As Long '編碼設置
 61 Dim EncodeErr As Boolean '編碼轉換時出錯Flag
 62 Public Enum EncodeEnum
 63     Default = 0
 64     ShifJis = 932
 65     JIS = 50220
 66     Utf8 = 65001
 67     GB2312 = 936
 68 End Enum
 69 
 70 
 71 Dim ch As Long
 72 '以上僅為GetNextLine函數用,為了不每次調用GetNextLine時候都重新定義,故將之做為全局的了,其實應是局部的
 73 '_______________________________________
 74 Dim lineArr As New Collection
 75 Dim strArr() As Byte
 76 Dim strArrlBuff As Long
 77 Private Const mcInitBuffSize As Long = 100 '初始分配空間大小,10K
 78 Dim mIgnoreQuotes As Boolean
 79 
 80 Public Function GetNextLine(ByRef col As Collection) As Integer
 81     '讀取文件的下一行文本,支持 vbCrLf、vbLf、vbCr 的多種分行符
 82     '返回1表示正常讀取了
 83     '返回-1也表示正常,但讀完了文件
 84     '返回0表示出錯或非法
 85     '1. 一般出錯返回0,並設置 lErrOccured=True
 86     '2. 如果上次讀完了文件,則允許再額外調用一次 GetNextLine (返回 0 並 _
 87       不提示出錯,lErrOccured 仍為 false,此算非法);如果再調用就出錯了 _
 88       (函數仍返回0,但 lErrOccured 為 true 此算出錯)
 89 
 90 
 91     '設置反映錯誤的標志變量
 92     lErrOccured = False '表示尚未發生錯誤;如后續程序中發生了錯誤再改為 True
 93     '判斷和設置狀態
 94     If lStatus = 0 Then
 95         'lStatus = 0:當前狀態非法,尚未打開文件,無法讀取
 96         GoTo errExit
 97     ElseIf lStatus < 0 Then
 98         GoTo errExit '不允許額外調用了,出錯
 99     End If
100     
101     '正常讀取的情況:此時 lStatus 要么為1要么為2,即要么文件已經打開, _
102       '要么已經進入讀取狀態了,總之讀取下一行是沒有問題的
103     lStatus = 2 '設置為2表示已經進入讀取狀態
104     
105     
106     '//////////////// 讀取文件,以找到“一行”的內容 ////////////////
107     On Error GoTo errExit  '有任何錯誤發生時都轉到errExit標簽處執行
108     
109     With af_Buff
110         '緩沖區逐漸沿文件前進,直到緩沖區起始位置超過文件總長讀完文件
111         Do Until .StartPosAbso > af_lngFileLength
112         
113             '============ (1)根據需要讀取文件的下一個緩沖區內容 ============
114             '若 .PtrInBuf=-1 表示要讀取下一個緩沖區,否則不讀取下一個,仍使用 _
115               當前緩沖區和 .PtrInBuf 指針
116             If .PtrInBuf < 0 Then
117                 '----從 .StartPosAbso 開始讀取一些字節存入緩沖區 .bufBytes()
118                 .BufLen = FileGetBytesLocal(.StartPosAbso, .bufBytes())
119                 If .BufLen <= 0 Then GoTo errExit '讀取出錯
120                 
121                 '----初始化緩沖區指針
122                 .PtrInBuf = 1
123                 '看是否需要忽略第一個 vbLf
124                 If .IgnoreFirstLf Then
125                     If .bufBytes(.PtrInBuf) = 10 Then '第1個字節確是 vbLf
126                         '忽略第一個 vbLf
127                         .PtrInBuf = .PtrInBuf + 1
128                     End If 'If .bufBytes(.PtrInBuf) = 10 Then
129                     
130                     .IgnoreFirstLf = False '恢復標志,不忽略第一個 vbLf
131                 End If 'If .IgnoreFirstLf Then
132                 
133                 '初始化下一行起始位置 ptrNextStrStartInBuf (下一行內容包含該字節)
134                 .ptrNextStrStartInBuf = .PtrInBuf
135             End If 'If .PtrInBuf < 0 Then
136             
137             '============ (2)逐個掃描緩沖區中的字節,查找分行符 ============
138             '掃描緩沖區中的字節,直到找到 vbCr或vbLf 或掃描完緩沖區
139             For .PtrInBuf = .PtrInBuf To .BufLen
140                 ch = .bufBytes(.PtrInBuf)
141                 Select Case State '34代表雙引號 44代表逗號
142                     Case NewFieldStart
143                         If ch = 34 Then
144                             If mIgnoreQuotes Then
145                                 strArrlBuff = strArrlBuff + 1
146                                 If strArrlBuff Mod mcInitBuffSize = 0 Then
147                                     ReDim Preserve strArr(1 To strArrlBuff + mcInitBuffSize)
148                                 End If
149                                 strArr(strArrlBuff) = ch
150                             End If
151                             State = QuotesField
152                         ElseIf ch = 44 Then
153                             lineArr.Add ""
154                             State = FieldSeparator
155                         ElseIf ch = 13 Or ch = 10 Then
156                             State = NewFieldStart
157                             Exit For
158                         Else
159                             strArrlBuff = strArrlBuff + 1
160                             If strArrlBuff Mod mcInitBuffSize = 0 Then
161                                 ReDim Preserve strArr(1 To strArrlBuff + mcInitBuffSize)
162                             End If
163                             strArr(strArrlBuff) = ch
164                             State = NonQuotesField
165                         End If
166                     Case NonQuotesField
167                         If ch = 44 Then
168                             lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) '代碼轉換 strArr
169                             Erase strArr
170                             ReDim strArr(1 To mcInitBuffSize)
171                             strArrlBuff = 0
172                             State = FieldSeparator
173                         ElseIf ch = 13 Then
174                             lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) '代碼轉換 strArr
175                             State = RowSeparator
176                         Else
177                             strArrlBuff = strArrlBuff + 1
178                             If strArrlBuff Mod mcInitBuffSize = 0 Then
179                                 ReDim Preserve strArr(1 To strArrlBuff + mcInitBuffSize)
180                             End If
181                             strArr(strArrlBuff) = ch
182                         End If
183                     Case QuotesField
184                         If ch = 34 Then
185                             If mIgnoreQuotes Then
186                                 strArrlBuff = strArrlBuff + 1
187                                 If strArrlBuff Mod mcInitBuffSize = 0 Then
188                                     ReDim Preserve strArr(1 To strArrlBuff + mcInitBuffSize)
189                                 End If
190                                 strArr(strArrlBuff) = ch
191                             End If
192                             State = QuoteInQuotesField
193                         Else
194                             strArrlBuff = strArrlBuff + 1
195                             If strArrlBuff Mod mcInitBuffSize = 0 Then
196                                 ReDim Preserve strArr(1 To strArrlBuff + mcInitBuffSize)
197                             End If
198                             strArr(strArrlBuff) = ch
199                         End If
200                     Case FieldSeparator
201                         If ch = 44 Then
202                             lineArr.Add ""
203                         ElseIf ch = 34 Then
204                             Erase strArr
205                             ReDim strArr(1 To mcInitBuffSize)
206                             strArrlBuff = 0
207                             If mIgnoreQuotes Then strArrlBuff = 1: strArr(strArrlBuff) = ch
208                             State = QuotesField
209                         ElseIf ch = 13 Then
210                             lineArr.Add ""
211                             State = RowSeparator
212                         Else
213                             strArrlBuff = strArrlBuff + 1
214                             If strArrlBuff Mod mcInitBuffSize = 0 Then
215                                 ReDim Preserve strArr(1 To strArrlBuff + mcInitBuffSize)
216                             End If
217                             strArr(strArrlBuff) = ch
218                             State = NonQuotesField
219                         End If
220                     Case QuoteInQuotesField
221                         If ch = 44 Then
222                             lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) '代碼轉換 strArr
223                             Erase strArr
224                             ReDim strArr(1 To mcInitBuffSize)
225                             strArrlBuff = 0
226                             State = FieldSeparator
227                         ElseIf ch = 13 Then
228                             lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) '代碼轉換 strArr
229                             State = RowSeparator
230                         ElseIf ch = 34 Then
231                             strArrlBuff = strArrlBuff + 1
232                             If strArrlBuff Mod mcInitBuffSize = 0 Then
233                                 ReDim Preserve strArr(1 To strArrlBuff + mcInitBuffSize)
234                             End If
235                             strArr(strArrlBuff) = ch
236                             State = QuotesField
237                         Else
238                             State = ErrorS '"語法錯誤: 轉義字符 \" 不能完成轉義 或 引號字段結尾引號沒有緊貼字段分隔符";
239                         End If
240                     Case RowSeparator
241                         If ch = 10 Then
242                             Erase strArr
243                             ReDim strArr(1 To mcInitBuffSize)
244                             strArrlBuff = 0
245                             State = NewFieldStart
246                             Exit For
247                         Else
248                             State = ErrorS '"語法錯誤: 行分隔用了回車 \\r。但未使用回車換行 \\r\\n ";
249                         End If
250                     Case ErrorS
251                         GoTo errExit
252                                             
253                 End Select
254             Next .PtrInBuf
255             
256             '退出 For 后,判斷是否找到了分行符 vbCr或vbLf
257             If .PtrInBuf <= .BufLen Then  '是否找到了 vbCr或vbLf
258                 If .PtrInBuf + 1 > .BufLen And _
259                   .StartPosAbso + .BufLen > af_lngFileLength Then
260                     '已經讀完文件
261                     lIsEndRead = True
262                     If lAutoClose Then CloseFile
263                 Else
264                     '還未讀完文件,再判斷是否文件只剩一個字節;若只剩一個字節並且 _
265                       '剩下的正好是 vbLf,並且下次要忽略掉 vbLf,則仍是已經讀完文件
266                     If .StartPosAbso + .BufLen = af_lngFileLength And .IgnoreFirstLf Then
267                         '讀取文件中的最后一個字節,只測試一下
268                         Dim tByt() As Byte, tRet As Integer
269                         tRet = FileGetBytesLocal(.StartPosAbso + .BufLen, tByt())
270                         If tRet <= 0 Then GoTo errExit '出錯處理
271                         If tByt(1) = 10 Then
272                             '已經讀完文件
273                             lIsEndRead = True
274                             If lAutoClose Then CloseFile
275                         End If
276                     End If
277                 End If
278                 .PtrInBuf = .PtrInBuf + 1
279             
280                 If lIsEndRead Then
281                     '已經讀完文件,一定 Exit Function
282                     
283                     Set col = lineArr
284                     Set lineArr = New Collection
285                     strArrlBuff = 0
286                     GetNextLine = 0
287                     
288                     Exit Function '已經讀完文件,一定 Exit Function
289                 Else 'If lIsEndRead Then
290                     If lineArr.Count <> 0 Then
291                         Set col = lineArr
292                         Set lineArr = New Collection
293                         strArrlBuff = 0
294                         GetNextLine = 1
295                         Exit Function
296                     End If
297                 End If 'If lIsEndRead Then
298                 
299             Else 'If .PtrInBuf <= .BufLen Then '是否找到了 vbCr或vbLf
300                  
301                  .PtrInBuf = -1
302                 '==== 准備繼續讀下一個緩沖區 ====
303                 .StartPosAbso = .StartPosAbso + .BufLen
304             End If 'If .PtrInBuf <= .BufLen Then '是否找到了 vbCr或vbLf
305         Loop
306     End With
307     
308     
309     '//////////// 全部讀完文件,看還有無剩余的 ////////////
310    
311         
312       Select Case State
313             Case NonQuotesField
314                  lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) '代碼轉換 strArr
315                  Erase strArr
316                  ReDim strArr(1 To mcInitBuffSize)
317                  strArrlBuff = 0
318             Case QuotesField
319                  GoTo errExit '"語法錯誤: 引號字段未閉合";
320             Case FieldSeparator
321                 lineArr.Add ""
322             Case QuoteInQuotesField
323                 lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) '代碼轉換 strArr
324                 
325         End Select
326         
327 
328         Set col = lineArr
329         Set lineArr = New Collection
330         strArrlBuff = 0
331         GetNextLine = 0
332 
333         
334         If lAutoClose Then CloseFile
335         lIsEndRead = True
336         '此時讀完文件,必須返回
337         Exit Function
338 
339     
340 
341 errExit:
342     lErrOccured = True
343     GetNextLine = 0
344     '為一般錯誤,不設置 lIsEndRead = True
345     If lAutoClose Then CloseFile
346 End Function
347 
348 Private Function EncodeStr(ByRef bytIn() As Byte, hasError As Boolean, Optional byteSize As Long = -1) As String
349 On Error GoTo errH:
350     Select Case Encode
351         Case Default
352             If byteSize > 0 Then
353                 ReDim Preserve bytIn(1 To byteSize)
354             End If
355             EncodeStr = bytIn
356             EncodeStr = StrConv(EncodeStr, vbUnicode)
357         Case ShifJis
358             EncodeStr = WCMB_Decode(ShifJis, bytIn, hasError, byteSize)
359         Case JIS
360              EncodeStr = WCMB_Decode(JIS, bytIn, hasError, byteSize)
361         Case Utf8
362             EncodeStr = WCMB_Decode(Utf8, bytIn, hasError, byteSize)
363         Case GB2312
364              EncodeStr = WCMB_Decode(GB2312, bytIn, hasError, byteSize)
365     End Select
366     hasError = False
367     Exit Function
368 errH:
369     hasError = True
370 End Function
371 
372 
373 ' 関數名    : WCMB_Decode
374 ' 返り値    : UNICODE文字列
375 ' 引き數    : cp    : 入力文字データのコードページ番號
376 '           : bytIn : 入力文字データ
377 ' 機能説明  : 入力文字データをUNICODEに変換する
378 ' 備考      : MultiByteToWideCharによる文字コード変換
379 Private Function WCMB_Decode(ByVal cp As Long, ByRef bytIn() As Byte, ByRef hasError As Boolean, Optional byteSize As Long = -1) As String
380     On Error GoTo ErrHandler
381 
382     Dim lngInSize As Long
383     Dim strBuf As String
384     Dim lngBufLen As Long
385     Dim lngRtn As Long
386     If byteSize > 0 Then
387         lngInSize = byteSize
388     Else
389         If bytIn(UBound(bytIn)) = 13 Then
390             lngInSize = UBound(bytIn) - 1
391         Else
392             lngInSize = UBound(bytIn)
393         End If
394     End If
395     lngBufLen = (lngInSize + 1) * 5
396     strBuf = String$(lngBufLen, vbNullChar)
397     lngRtn = MultiByteToWideChar _
398         (cp, 0, bytIn(1), lngInSize, StrPtr(strBuf), lngBufLen)
399     If lngRtn Then
400         WCMB_Decode = Left$(strBuf, lngRtn)
401     End If
402     hasError = False
403     Exit Function
404 ErrHandler:
405     WCMB_Decode = ""
406     hasError = True
407 End Function
408 
409 Public Sub Init()
410 
411     ReDim strArr(1 To mcInitBuffSize) 'CSV 各個單元 緩沖區
412     strArrlBuff = 0
413                  
414     Erase af_Buff.bufBytes '緩沖區
415     
416     
417 
418     af_lngFileLength = 0
419     af_Buff.StartPosAbso = 1 '當前緩沖區的起始處所在的文件位置
420     af_Buff.ptrNextStrStartInBuf = 1
421     
422     '此作為標志,=-1表示下次運行 GetNextLine 要重新讀取新的緩沖區 _
423       '否則不重新讀取,仍使用當前緩沖區和 .PtrInBuf 指針
424     af_Buff.PtrInBuf = -1
425     
426     lErrOccured = False
427 
428     
429     af_Buff.IgnoreFirstLf = False '初始化標志:當前緩沖區不需要忽略第一個字節(若是vblf)
430     
431     lIsEndRead = False
432 End Sub
433 
434 Public Function GetPercent(Optional DotNum As Integer = 2) As Single
435     'DotNum保留幾位小數,<0或>7為不保留小數
436     Dim sngPerc As Single
437     
438     If af_lngFileLength > 0 Then
439         If af_Buff.PtrInBuf < 0 Then
440             sngPerc = (af_Buff.StartPosAbso - 1) / af_lngFileLength
441         Else
442             sngPerc = (af_Buff.StartPosAbso + af_Buff.PtrInBuf - 2) / af_lngFileLength
443         End If
444     End If
445     
446     If DotNum >= 0 Or DotNum <= 7 Then
447         Dim Temp As Long
448         Temp = 10 ^ DotNum
449         sngPerc = Int(Temp * sngPerc + 0.5) / Temp
450     End If
451     
452     GetPercent = sngPerc
453 End Function
454 
455 Public Sub CloseFile()
456     If lFileNum > 0 Then Close lFileNum: lFileNum = 0
457     lStatus = -1 '表示文件已關閉
458     '不Init,防止讀取行后自動關閉文件時狀態變量被初始化;在OpenFile時會Init
459 End Sub
460 
461 Public Function OpenFile() As Boolean
462     If lFileNum > 0 Then CloseFile '如果已打開了文件,則先關閉它
463     lFileNum = FreeFile '獲得一個可用的文件號(同時屬性 FileNum 的值也自動改變)
464     On Error GoTo errH '如果一下程序發生任何錯誤,就轉到 errH 標簽處執行
465     If Dir(lFileName, 31) = "" Then GoTo errH '如果文件不存在,就轉到 errH 標簽處執行
466     Open lFileName For Binary Access Read As #lFileNum '以二進制方式打開文件
467     lStatus = 1 '表示文件已打開
468     Init '初始化操作
469     af_lngFileLength = LOF(lFileNum) '設置文件總大小
470     OpenFile = True
471     Exit Function
472 errH:
473     If lFileNum > 0 Then CloseFile
474     OpenFile = False
475 End Function
476 
477 
478 
479 Private Function FileGetBytesLocal(ByVal ReadPos As Long, _
480                                          ArrBytes() As Byte, _
481                           Optional ByVal EndingBorder As Long = 0, _
482                           Optional ByVal ReadMax As Long = 16384) As Long
483                           'Optional ByVal ReadMax As Long = 16384, _
484     '從文件號 lFileNum 中的 ReadPos 位置開始讀取一批字節
485     '從參數ArrBytes()返回讀取的字節內容,會重新定義ArrBytes()數組
486     '所讀取的字節數不確定,如果文件中有足夠的內容,就讀取ReadMax個字節, _
487       '否則就讀到文件尾(當EndingBorder參數<=0時)或讀到EndingBorder _
488       '為止(當EndingBorder參數>0時)
489     'ShowResume 指定如果讀取出錯,是否彈出對話框提示
490       '若ShowResume=1,提示框中有"重試"和"取消"兩個按鈕;
491       '若ShowResume=2,出錯時提示框中有"終止"、"重試"和"忽略"三個按鈕;
492       '若ShowResume=0,出錯時不彈出提示框,不彈出提示框就不能在發生錯誤時重試
493     '返回讀取的字節數,若失敗返回<=0,若用戶“忽略”則返回=0;_
494       '若用戶終止或取消或無提示框,則返回<0
495     
496     Dim lngUBound As Long
497     
498     If EndingBorder <= 0 Then EndingBorder = LOF(lFileNum)
499     If EndingBorder < ReadPos Then
500         FileGetBytesLocal = -1
501         Exit Function
502     End If
503     
504     On Error GoTo errH
505     If EndingBorder - ReadPos + 1 >= ReadMax Then lngUBound = ReadMax Else _
506       lngUBound = EndingBorder - ReadPos + 1
507     
508     ReDim ArrBytes(1 To lngUBound) As Byte
509     
510     Get #FileNum, ReadPos, ArrBytes
511 
512     FileGetBytesLocal = lngUBound
513     Exit Function
514 errH:
515      FileGetBytesLocal = -1
516 End Function
517 
518 
519 
520 Private Sub Class_Initialize()
521     lAutoOpen = True '設置 FileName 屬性時自動打開文件
522     lAutoClose = True '讀取行讀完文件或出錯時 自動關閉文件
523     mIgnoreQuotes = False
524 End Sub
525 
526 Private Sub Class_Terminate()
527     CloseFile
528     Erase af_Buff.bufBytes
529 
530 End Sub
531 
532 
533 Public Property Get FileName() As String
534     FileName = lFileName
535 End Property
536 
537 Public Property Let FileName(ByVal vNewValue As String)
538     If lFileNum > 0 Then CloseFile
539     lFileName = vNewValue
540     If lAutoOpen Then OpenFile
541 End Property
542 
543 Public Property Get FileNum() As Integer
544     FileNum = lFileNum
545 End Property
546 
547 Public Property Get Status() As Integer
548     Status = lStatus
549 End Property
550 
551 Public Property Get IsEndRead() As Boolean
552     IsEndRead = lIsEndRead
553 End Property
554 
555 Public Property Get AutoOpen() As Boolean
556     AutoOpen = lAutoOpen
557 End Property
558 
559 Public Property Let AutoOpen(ByVal vNewValue As Boolean)
560     lAutoOpen = vNewValue
561 End Property
562 
563 Public Property Get AutoClose() As Boolean
564     AutoClose = lAutoClose
565 End Property
566 
567 Public Property Let AutoClose(ByVal vNewValue As Boolean)
568     lAutoClose = vNewValue
569 End Property
570 
571 
572 Public Property Get ErrOccured() As Boolean
573     ErrOccured = lErrOccured
574 End Property
575 
576 Public Property Let ErrOccured(ByVal vNewValue As Boolean)
577     lErrOccured = vNewValue
578 End Property
579 
580 Public Property Get Encode() As EncodeEnum
581     Encode = lEncode
582 End Property
583 
584 Public Property Let Encode(ByVal vNewValue As EncodeEnum)
585     lEncode = vNewValue
586 End Property
587 
588 Public Property Get IsEncodeErr() As Boolean
589     IsEncodeErr = EncodeErr
590 End Property
591 
592 Public Property Let IgnoreQuotes(ByVal vNewValue As Boolean)
593     mIgnoreQuotes = vNewValue
594 End Property
595 
596 Public Property Get IgnoreQuotes() As Boolean
597     IgnoreQuotes = mIgnoreQuotes
598 End Property
讀Csv文件 類

 

 

 1 Dim aFile As clsCsv
 2 
 3 Dim strCol As Collection
 4 
 5 Set aFile = New clsCsv
 6 
 7 aFile.FileName = "C:\Users\Administrator\Desktop\Àϱøд«³ÌÐòÔ´´úÂë\µÚ6ÕÂ\Îı¾Îļþ°´ÐжÁÈ¡\ʾÀýÎļþ(»»Ðзû·ÖÐÐ).csv"
 8 
 9 aFile.Encode = Utf8
10 
11 Do Until aFile.IsEndRead
12         aFile.GetNextLine strCol
13         If aFile.ErrOccured Then
14             Exit Do
15         Else
16            i = i + 1
17            ' Debug.Print strLine
18             Label1.Caption = aFile.GetPercent * 100 & "%"
19             If i Mod 500 = 1 Then DoEvents
20         End If
21     Loop

 

 


注意!

本站转载的文章为个人学习借鉴使用,本站对版权不负任何法律责任。如果侵犯了您的隐私权益,请联系我们删除。



 
  © 2014-2022 ITdaan.com 联系我们: