-
[Adodb.Stream] json 파일로 추출하기VB(A) 2017. 1. 10. 12:55자료를 기준에 따라 취합한 후ADODB.Stream 을 이용해 UTF-8 의 텍스트 파일로 추출하는 매크로Option Base 1Sub Macro()Dim ADOStream As ObjectDim UnitData As RangeDim SingleRange As RangeDim v() As StringDim i As IntegerDim ColumnsCount As IntegerSet UnitData = Range("A8", Cells(Rows.Count, "A").End(3)) '추출할 데이터 영역(A열)ColumnsCount = Range("A5").CurrentRegion.Columns.Count '열 개수ReDim v(ColumnsCount) '열개수에 맞게 재배열Set ADOStream = CreateObject("ADODB.Stream") 'ADODB.Stream 개체생성With ADOStream 'ADOStream 설정.Open.Charset = "UTF-8".Type = 2.writetext "[" & vbLf ''첫 대괄호 입력End WithFor Each SingleRange In UnitData '데이터영역 순환'A열부터 마지막열까지 순환하면서'문자는 앞뒤로 " 를 붙여주고 숫자는 "를 붙이지 않은 채 배열에 삽입For i = 1 To ColumnsCountv(i) = """" & Cells(6, SingleRange.Offset(, i - 1).Column) & """:" & CheckNumber(SingleRange.Offset(, i - 1))Next iADOStream.writetext "{" & Join(v, ",") & "}" & vbLf '앞뒤로 {} 를 붙여줌Next SingleRangeErase v '배열 초기화With ADOStream.writetext "]" '맨 마지막에 ] 삽입.SaveToFile ThisWorkbook.Path & "\tmp.json", 2 '파일 성.Close 'ADOStream 닫기End WithMsgBox "추출성공"End SubFunction CheckNumber(SingleData As String) As StringSelect Case IsNumeric(SingleData)Case TrueCheckNumber = SingleDataCase FalseCheckNumber = """" & SingleData & """"End SelectEnd Function
cs 'VB(A)' 카테고리의 다른 글
[정규식] 일치하는 문자열만 추출(lazy 모드) (0) 2017.02.05 순서대로 필터링하기 (0) 2017.02.04 [Dictionary] 일정 정보만을 그대로 두고 여럿 존재하는 값(행렬 전환하여 붙이기) (0) 2016.12.27 숫자 합치기 + 음수만 빨갛게 (0) 2016.12.23 주민번호로 만나이 구하기(외국인 포함) (0) 2016.12.03 댓글