csv出力Java_CSV 出力测试

Public dic As Object '字典对象key：符合条件的excel的路径，value：对应的tag值

Private Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME) '读取系统时间API'* 自定义系统时间类型

PrivateType SYSTEMTIME

wYearAs IntegerwMonthAs IntegerwDayOfWeekAs IntegerwDayAs IntegerwHourAs IntegerwMinuteAs IntegerwSecondAs IntegerwMillisecondsAs Integer

EndTypeSubtest()

tt=TimerDimcsvFile$

Application.ScreenUpdating= False

Set dic = CreateObject("scripting.dictionary")

setLog ("--------------开始出力----------------")Call FindFile("G:\CSV")

arr=dic.keysFor i = 0 To UBound(arr)

csvFile= "c:\" & dic(arr(i)) & ".csv"

Callgetdata(arr(i), dic(arr(i)), csvFile)NextiSet dic = NothingsetLog ("--------------结束出力----------------")MsgBox Timer -tt

Application.ScreenUpdating= True

End Sub

Function getit(ByVal filename As String) As String

Dim f, shell, s As String, i As Long

With CreateObject("scripting.filesystemobject")Set f =.GetFile(filename)Set shell = CreateObject("Shell.Application").Namespace(f.ParentFolder.Path)

s= shell.GetDetailsOf(shell.Items.Item(f.Name), 18)End Withgetit=sEnd Function

Function GetExcelTag(ByVal strPath As String) AsWorksheetSet xlapp = CreateObject("excel.application")

xlapp.Visible= Falsefile1= Dir(strPath & "")Do While file1 <> ""

Set xlbook = xlapp.Workbooks.Open(strPath &file1)

Debug.Print xlbook.BuiltinDocumentProperties("Keywords")

xlbook.Close (True)

file1= Dir

Loop

'Set xlbook = xlapp.Workbooks.Open(strPath)

'Set xlsheet = xlbook.Worksheets(1)

'xlbook.Close (True)

xlapp.Quit'Set xlsheet = Nothing

Set xlbook = Nothing

Set xlapp = Nothing

End Function

Public Sub FindFile(mPath As String, Optional sFile As String = "")Dim s As String, sDir() As String

Dim i As Long, d As Long, morder$, csvFile$Set xlapp = CreateObject("excel.application")

xlapp.Visible= False

If Right(mPath, 1) <> "\" ThenmPath= mPath & "\"

End If

'查找目录下的文件

s = Dir(mPath & sFile, vbArchive + vbDirectory + vbNormal +vbReadOnly)Do While s <> ""

If InStr(s, ".xlsx") > 0 Then

Set xlbook = xlapp.Workbooks.Open(mPath &s)

dic(mPath& s) = xlbook.BuiltinDocumentProperties("Keywords") 'getit(mPath & s)

xlbook.Close (True)End Ifs= Dir

Loop

'查找目录下的子目录

s = Dir(mPath, vbArchive + vbDirectory + vbNormal +vbReadOnly)Do While s <> ""

If s <> "." And s <> ".." Then

If (GetAttr(mPath & s) And vbDirectory) = vbDirectory Thend= d + 1

ReDim PreservesDir(d)

sDir(d)= mPath &sEnd If

End Ifs= Dir

Loopxlapp.QuitSet xlbook = Nothing

Set xlapp = Nothing

'开始递归

For i = 1 Tod

FindFile sDir(d)& "\"

Next

End Sub

Function getdata(sPath As Variant, model As String, csvFilePath AsVariant)Dim xlapp AsExcel.ApplicationDim xlbook AsExcel.WorkbookDim xlsheet AsExcel.WorksheetWithActiveWorkbook.Sheets(model)

filename= Mid(sPath, InStrRev(sPath, "\") + 1, Len(sPath) - InStrRev(sPath, "\") - 5) '把文件名提取出来'--------------------------------------------------------------------------------

If Dir(csvFilePath) = "" ThenOpen csvFilePathFor Output As #1

Print #1, "filename," & Join(Application.Transpose(.Range("a2:a" & .[A65536].End(xlUp).Row)), ",")

Close #1

End If

'--------------------------------------------------------------------------------'如果还未生产csv文件则生成

fieldNums=.[A65536].End(xlUp).Row'如果key存在1个以上的情况该怎么处理？

'zyx = i '记录key所在cell的行

For i = 2 To.[B65536].End(xlUp).RowIf .Cells(i, 2).Value = "key" Then KeyValue = .Cells(i, 1).ValueNexti'--------------------------------------------------------------------------------'找到key

Set xlapp = CreateObject("excel.application")

xlapp.Visible= False

Set xlbook =xlapp.Workbooks.Open(sPath)Set xlsheet = xlbook.Worksheets(1)Dim flag As Boolean, MoveFlag As Boolean, strRow$'--------------------------------------------------------------------------------' 打开excel表开始读数据，优先找key

MoveFlag= False

If KeyValue <> "" ThenxROW= xlsheet.Range(KeyValue).Row '记录key所在cell的行

yColumn = xlsheet.Range(KeyValue).Column '记录key所在cell的列

For xyz = xROW To xlsheet.Cells(65536, yColumn).End(xlUp).RowIf xlsheet.Cells(xyz, yColumn).Value <> "" Thenflag= TruestrRow= strRow & filename & ","

'检查

For i = 2 TofieldNumsIf .Cells(i, 3).Value = "○" Then '-----------------------------------------检查是必填项

'如果是和key所在的行是一样的情况：检查的就是偏移行

If xlsheet.Range(.Cells(i, 1).Value).Row <> xROW Then

If xlsheet.Range(.Cells(i, 1).Value) <> "" ThenstrRow= IIf(i = fieldNums, strRow & xlsheet.Range(.Cells(i, 1).Value), strRow & xlsheet.Range(.Cells(i, 1).Value) & ",")ElsesetLog ("【文件：" + filename + "| key值：" + xlsheet.Cells(xyz, yColumn).Value + "cell名称：" + .Cells(i, 1).Value + "(行：" + Str(xlsheet.Range(.Cells(i, 1).Value).Row) + "列：" + Str(xlsheet.Range(.Cells(i, 1).Value).Column) + ")的值不能为空!】")'log出力

flag = FalseMoveFlag= True

End If

Else

If xlsheet.Range(.Cells(i, 1).Value).Offset(xyz - xROW, 0) <> "" ThenstrRow= IIf(i = fieldNums, strRow & xlsheet.Range(.Cells(i, 1).Value).Offset(xyz - xROW, 0), strRow & xlsheet.Range(.Cells(i, 1).Value).Offset(xyz - xROW, 0) & ",")ElsesetLog ("【文件：" + filename + "| key值：" + xlsheet.Cells(xyz, yColumn).Value + "cell名称：" + .Cells(i, 1).Value + "(行：" + Str(xyz) + "列：" + Str(xlsheet.Range(.Cells(i, 1).Value).Column) + ")的值不能为空!】")'log出力

flag = FalseMoveFlag= True

End If

End If

Else '不检查

strRow = IIf(i = fieldNums, strRow & xlsheet.Range(.Cells(i, 1).Value), strRow & xlsheet.Range(.Cells(i, 1).Value) & ",")End If

Nexti'------------------------------------------------------------------------------------------'出力到csv

If flag ThenOpen csvFilePathFor Append As #2

Print #2, strRow

Close #2setLog ("【文件：" + filename + "| Key值：" + xlsheet.Cells(xyz, yColumn).Value + "(行：" + Str(xyz) + "列：" + Str(yColumn) + ")正常出力!】")End If

Else '-----------------------------------------------------------------------'出力log 表示为key的值不能为空’该条数据不出力

setLog ("【文件：" + filename + "| (行：" + Str(xyz) + "列：" + Str(yColumn) + ")Key值不能为空!】")End IfstrRow= "" '--------------------------------------------------------情况临时存放数据开始进行下一次的循环

NextxyzElse '---------------------------------------------------------------------------没有key的场合只跑一遍

flag = True

'----------------------------------------------------------------------------各项目检查

For i = 2 TofieldNumsIf .Cells(i, 3).Value = "○" Then '检查是必填项

If xlsheet.Range(.Cells(i, 1).Value) <> "" ThenstrRow= strRow & xlsheet.Range(.Cells(i, 1).Value) & ","

ElsesetLog ("【文件：" + filename + "| key值：" + xlsheet.Cells(xyz, yColumn).Value + "cell名称：" + .Cells(i, 1).Value + "(行：" + Str(xlsheet.Range(.Cells(i, 1).Value).Row) + "列：" + Str(xlsheet.Range(.Cells(i, 1).Value).Column) + ")的值不能为空!】")'log出力

flag = FalseMoveFlag= True

End If

Else '不检查

strRow = strRow & xlsheet.Range(.Cells(i, 1).Value) & ","

End If

NextiIf flag Then

'出力到csv

Open csvFilePath For Append As #2

Print #2, strRow

Close #2setLog ("【文件：" + filename + "| Key值：" + xlsheet.Cells(xyz, yColumn).Value + "(行：" + Str(xyz) + "列：" + Str(yColumn) + ")正常出力!】")End If

End If

'------------------------------------------------------------------------------------------关闭打开的execl对象

xlbook.Close (True)

xlapp.QuitSet xlsheet = Nothing

Set xlbook = Nothing

Set xlapp = Nothing

End With

If MoveFlag Then

'只要过程中友出现异常了，移动excel到指定文件夹

End If

End Function

Private Sub setLog(strInput AsVariant)Dim SysTime AsSYSTEMTIME, logPath$, strReturn$

GetSystemTime SysTime

logPath= "c:\" + CStr(Year(Now)) + Format(Month(Now), "00") + Format(Day(Now), "00") + ".log"strReturn= CStr(Date) & "_" & CStr(Time) + " " + Format(CStr(SysTime.wMilliseconds), "000") + "　" & strInput '添加系统时间后的录入字符

If Dir(logPath) = "" ThenOpen logPathFor Output As #3

Print #3, strReturn

Close #3

ElseOpen logPathFor Append As #4

Print #4, strReturn

Close #4

End If

End Sub

Sub gettest(wSheet AsWorksheet)

Debug.Print wSheet.[a1]End Sub

Subaatest()

GetExcelTag ("G:\CSV\")End Sub