EXCEL isFormula2010を応用して数式がそのまま読めるCSVを作るVBAマクロ

###前記事の言い訳
　今日も2回書き直していたisFormula2010ですが、原因は、これをさらに応用して、数式がそのまま出力されて、なんとExcelで読み込むと数式がそのまま数式になるというマクロを作っていたためです。
###下準備
　ここで、参照設定としてMicrosoft ActiveX Data Objects x.x Libraryが必要になります。
このVBAマクロはADODBでUtf-8を使用するため、ユニコード文字も文字化けしません。
ただし、表示形式は引き継がないので日付などは表示が崩れます。
```VB.net:EXPORTCSVFormulaasFormula
Option Explicit
\#If Win64 Then
Declare PtrSafe Function SetCurrentDirectory Lib "kernel32" Alias _
                            "SetCurrentDirectoryA" (ByVal CurrentDir As String) As LongPtr
\#Else
Declare Function SetCurrentDirectory Lib "kernel32" Alias _
                            "SetCurrentDirectoryA" (ByVal CurrentDir As String) As Long
\#End If
Sub ExportCsvAsFormulaIsFormula()
'##Reffernce Setting Need [Microsoft ActiveX Data Objects x.x Library]
'https://msdn.microsoft.com/ja-jp/library/cc364078.aspx
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = ActiveSheet
Dim strPath As String: strPath = wb.Path & "\"
Dim strFName As String: strFName = wb.Name
Dim arN() As String: arN() = Split(strFName, ".")
Dim arF()
Dim r As Range, Urng As Range, buf As String
Dim ADOStream As New ADODB.Stream
Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim LastRow As Long, LastCol As Long, i As Long, j As Long, k As Long, bu1 As String
SetCurrentDirectory strPath
If arN(UBound(arN)) Like "xl?*" Then buf = Right(strFName, Len(arN(UBound(arN))) + 1): strFName = Replace(strFName, buf, "", 1, -1, vbTextCompare): strFName = strFName & ".CSV"
For Each r In ws.UsedRange
If r.MergeCells = True Then MsgBox "This Worksheet Cannnot CSV Because Merge cells are.", vbCritical + vbInformation, "Sorry": Exit Sub
Next
Erase arN: buf = ""
If FSO.fileexists(strPath & strFName) Then Kill strPath & strFName
With ADOStream
.Mode = adModeReadWrite
.Type = adTypeText
.Charset = "UTF-8"
.LineSeparator = adCRLF
.Open
.Position = 0
Set Urng = ws.UsedRange
LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To LastRow
 For j = 1 To LastCol
 ReDim Preserve arN(0 To j - 1)
 If isFormula2010(ws.Range(Cells(i, j).Address)) = True Then
 bu1 = CStr(ws.Range(Cells(i, j).Address).Cells.Formula)
 bu1 = Replace(bu1, Chr(34), Chr(34) & Chr(34), 1, -1, vbTextCompare)
 bu1 = bu1
 arN(j - 1) = bu1
 Else
 arN(j - 1) = CStr(Cells(i, j).Value)
  Next j
 For k = LBound(arN) To UBound(arN) - 1
  buf = buf & Chr(34) & arN(k) & Chr(34) & Chr(44)
 Next k
 buf = buf & Chr(34) & arN(UBound(arN)) & Chr(34) & vbCrLf
 .Position = .Size
 .WriteText buf, adWriteChar
 Erase arN buf = ""
Next i
.SaveToFile strPath & strFName, adSaveCreateOverWrite
.Close
End With
End Sub
Function isFormula2010(Rng As Range) As Boolean
If Rng.Value = CStr(Rng.Cells.Formula) Then isFormula2010 = False Else isFormula2010 = True
End Function
```
このように見えているEXCELがあります
2016/6/12 0:42
2	1	3	2016/4/5
実は数式が入っており、
2	1	正解	=IF(B1=1,"正解","誤り") ＝NOW()
2	1	=SUM(A2:B2) 2016/4/5
というのが本当です
これをマクロで変換します。
このマクロはEXCELのViSUAL　BASIC EDITORに貼りつけていったん保存してください。保存名するファイル名はCSVを作る時にCSVファイルを削除するため、20160612QIIQ.xlsm
といった日付がある名前にしてください。
マクロを動かすと20160612QIIQ.csvができます。
中身はこんな感じです。
"2","=2/A1","=IF(B1=1,""正解"",""誤り"")","=NOW()"
"2","1","=SUM(A2:B2)","42465"
これをエクセルで開くと
2	1	正解	42465.03997
2	1	3	42465
日付は崩れますが、NOW関数は生きており、そのまま現在の時を表示しています。
しかし、欠点はあります。
まず日付が崩れます。
あと結合があるとうまくいかないのではじきます
またADODBはネットワーク上にファイルがあると3004エラーを起こします。
その時は strPathではなく、デスクトップやドキュメントフォルダを指定してください。
###参考
[ADO エラー リファレンス](https://msdn.microsoft.com/ja-jp/library/cc407866.aspx)
[Excel VBA初心者です。ローカルのテキストファイル(Unicode)を読込みネットワーク上のテキストファイル(Unicode)に書き込む処理を実装したいのですが、書き込みの際にエラーとなります。-Yahoo!知恵袋](http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q13109639353)
[ネットワークドライブにChDriveする-OfficeTanaka](http://officetanaka.net/other/extra/tips15.htm)
これを参考にカレントを変更するようにしてもうまくいかないようです。OneDriveユーザーはご注意ください。
[VBAをEXCEL2007, 2010, 2013の32/64 bitの全てに対応させるにはどうすれば良いのか？解決！](http://blog.goo.ne.jp/mumbai/e/dc90cf94fc40baebf807f1913de4fc10)
冒頭部分はこちらを参考にしました