#AccessのWindows全バージョンの致命的なバグ
##CSVのSample
これらのcsvファイルを Notepad /a "C:\hoge\warekitest.csv"にコピーする。
保存するときに必ずANSI形式で保存されるか、確認すること。（上書きすると自動的に書き換える場合がある）
No,F01Name,F02Cur_Income,F03PurchaseDate,F04DatePaid
1,"John Smith",\2000,S20.1.1,S20/1/1
No,F01Name,F02Cur_Income,F03PurchaseDate,F04DatePaid
1,"John Smith",\2000,"S20.1.1","S20/1/1"
No,F01Name,F02Cur_Income,F03PurchaseDate,F04DatePaid
1,"John Smith",\2000,S20.1.1,S20/1/1
2,"Samantha Smith",\1000,1945.1.1,昭和45年1月1日
3番目の例はなぜかUTF-8にしないと日本語が文字化け。日付の区切りをドットにする。これは
No,F01Name,F02Cur_Income,F03PurchaseDate,F04DatePaid
1,"John Smith",\2000,"S20.1.1","S20/1/1"
で保存されたファイルに2行目を書き加えて上書き保存したのが原因である。日本語だけでANSIからUTF-8に書き換わるのは疑問だが、とりあえずアクセスのインポート設定は3つとも次のようにしてみる。結果は変わらない。
すると1945.1.1はは読み込まれる。
なお、ドットではなくスラッシュでも読み込まれる。
#結論
##AccessはCSVの和暦を認識できない
和暦を正しく書いてもバグになる。
つまりAccessは和暦を認識できない。
##これが仕様だという言い訳をするなら日本から撤退しろ。欠陥商品を売るんじゃない。
Currencyの円マークは通貨として認識する。金には汚い。ExcelはS20.5.2のようなドット区切り以外は和暦として読むし、最新版ならドット区切りでも読める。
つまりAccessだけ忘れているのだ。レジストリにも設定しておいて何が仕様だ。ありない。仕様というなら隠蔽なので訴えてもいいですか。
###実際にExcelで読み込む場合と比較する
####CSV
#####A
No,F01Name,F02Cur_Income,F03PurchaseDate,F04DatePaid
1,"John Smits",\2000,"S20.1.1","S20/1/1"
2,"Samantha Smits",\1000,"1945.1.1 11:23:24AM","1975年1月1日 11:23:24"
#####B
No,F01Name,F02Cur_Income,F03PurcaseDate,F04DatePaid
1,"John Smits",\2000,"S20.1.1","昭和20年1月1日"
2,"Samantha Smits",\1000,"1945/1/1 11:23:24AM","1975年1月1日 11:23:24"
###変換コード(Excel)
Sub xlcsvChange()
'For Excel
'
'C:\hogeにあると仮定したCSVデータベースを読み込みます
'コードはShift-Jis =ANSI 932
'No , F01Name, F02Cur_Income, F03PurchaseDate, F04DatePaid
'1,"John Smith",\2000,"S20.1.1","S20/1/1"
'2,"Samantha Smith",\1000,"1945.1.1 11:23:24AM","1975年1月1日 11:23:24"
ChDir "C:\hoge"
Workbooks.OpenText Filename:="C:\hoge\warekitest.csv", Origin:=932, DataType:=xlDelimited, startrow:=1, textqualifier:=xlTextQualifierDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True, Space:=False, Other:=False, OtherChar:="", FieldInfo:= _
Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 5), Array(5, 5)), DecimalSeparator:=".", ThousandsSeparator:=",", TrailingMinusNumbers:=True, local:=True
End Sub
####Excelの変換結果
#####A
Aの場合S20.1.1は日付になっている。2013では読めなかった。しかし2019年版でもドット区切りで時間がつくと西暦も読めない
#####B
このように時刻がつくと yyyy/MM/dd hh:mm形式以外は読み込めない。
しかし、漢字の場合でもExceは全く読み込めないことはない。あとのAnswersはこの欠陥を事実上認めている。というか開き直っている。
なお、この"1945/1/1 11:23:24AM"は"1945/1/1 11:23:24 AM"と
スペースが入っていなかったからである。AM/PMをつけている場合、スペースがないと読み込みに失敗する。
後述のマクロはそれを回避した。また、AccessはAM PM形式はサポートしていないというのがわかった。
#結論
##これはAccessのすべてのバージョンに存在するバグでありただちに修正すべきである
##理由 Excelとの整合性が取れず、ユーザーが混乱するから
#関連質問でも間違った回答を平気で載せて買った客を追い返す失礼極まりないマイクロソフト
###企業倫理が問われざるを得ないAnswer
Accessのテーブルに、日付形式のフィールドをインポートすると、エラーになる
Accessのテーブルに、ＣＳＶ形式のデータのインポートをしたいのですが、日付と時刻のフィールドだけエラーになり、値が格納されません。
他のフィールドは、正しい値が格納されています。
インポートエラーのテーブルが自動作成されて、データ型の変換エラーと表示されます。
日付の項目は、漢字の表示形式（2017年10月1日）、時刻は、コロン表示（11:34:44）のデータです。
エラーを出さずに、正しく取り込みする方法があれば、ご教授下さい。
よろしくお願い致します。
このスレッドはロックされています。質問をフォローすることや役に立つと投票することはできますが、このスレッドに返信することはできません。
質問情報
最終更新日 2019年10月16日 表示 4,202 適用先:
Office
Access / その他/不明 / Office 2013
回答
sk.exe
Accessのテーブルに、ＣＳＶ形式のデータのインポートをしたいのですが、
日付と時刻のフィールドだけエラーになり、値が格納されません。
インポートエラーのテーブルが自動作成されて、データ型の変換エラーと表示されます。
日付の項目は、漢字の表示形式（2017年10月1日）、時刻は、コロン表示（11:34:44）のデータです。
・yyyy年m月d日形式ではなく、yyyy/m/d 形式とするよう、
CSVファイル内の日付部分の値をあらかじめ書き換えておく。
・日付/時刻型ではなくテキスト型のフィールドとしてインポートし、
インポートをしてから（クエリなどで）型変換を行なうようにする。
以上のいずれかでどうぞ。
###この回答は嘘
前述のようにExcelで読める。Accessで読めないというのはありえない。
そして回避策はCSVファイルの日付部分の値を書き換えるしかない。
通常こうしたトラブルはデータが多いもので発生するため、型変換ではおそすぎる。
#回避策
##Excelでテキストからxlsxに変換して取り込む
これから修正するが、OpenTextの最大の弱点はフィールド情報が130列以上は行継続文字（半角アンダーバーのこと）を24以上使い切ってしまう。つまりOpenTextでは130列を超えたあたりで自動記録が効かないことがわかった。この一方でクエリーテーブルは255列を超えても列情報を指定してなおかつExcelに取り込める。
Sub xlcsvChangeAndReg()
'For Excel
'C:\hogeにあると仮定したCSVデータベースを読み込みます
'コードはShift-Jis =ANSI 932
'No , F01Name, F02Cur_Income, F03PurcaseDate, F04DatePaid
'1,"John Smits",\2000,"S20.1.1","S20/1/1"
'2,"Samantha Smits",\1000,"1945.1.1 11:23:24AM","1975年1月1日 11:23:24"
Dim Reg As New RegExp, MC As MatchCollection, M As Match, iM As Long, SubM As SubMatches
Dim Reg2 As New RegExp
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet
Dim wb1 As Workbook
Dim buf As String, R As Range
Dim tbuf As String
ChDir "C:\hoge"
Workbooks.OpenText Filename:=C:\hoge\warekitest.csv", Origin:=932, DataType:=xlDelimited, startrow:=1, textqualifier:=xlTextQualifierDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True, Space:=False, Other:=False, OtherChar:="", FieldInfo:= _
Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 5), Array(5, 5)), DecimalSeparator:=".", ThousandsSeparator:=",", TrailingMinusNumbers:=True, local:=True
Set wb1 = Workbooks(Workbooks.Count)
Set ws = wb1.Worksheets(1)
Reg.Global = True:
Reg.IgnoreCase = False
Reg.MultiLine = False
Reg.Pattern = "([0-9]{4}).([0-9]{1,2}).([0-9]{1,2})(日|\s)"
Reg2.Global = True: Reg2.IgnoreCase = False: Reg2.MultiLine = True: Reg2.Pattern = "([A-Z]{1}[0-9]{1,2}|[A-Z]{1}元)\.[0-9]{1,2}\.[0-9]{1,2}"
Debug.Print wb1.Name
For Each R In ws.UsedRange
buf = R.Value
If Reg.Test(StrConv(buf, vbNarrow)) = True Then
tbuf = StrConv(buf, vbNarrow)
tbuf = Replace(Replace(tbuf, "AM", " AM", 1, 1, vbTextCompare), "PM", " PM", 1, 1, vbTextCompare)
tbuf = Reg.Replace(tbuf, "$1/$2/$3 ")
If Reg2.Test(tbuf) Then
tbuf = Reg2.Replace(tbuf, "$1/$2/$3")
End If
R.Value = tbuf
End If
If Err.Number <> 0 Then Debug.Print Err.Number, Err.Description: Err.Clear
Next
Dim fso As New FileSystemObject
If fso.FileExists(fso.GetParentFolderName(wb1.FullName) & "\" & fso.GetBaseName(wb1.FullName) & ".xlsx") Then fso.FileExists (fso.GetParentFolderName(wb1.FullName) & "\" & fso.GetBaseName(wb1.FullName) & ".xlsx
wb1.SaveAs Filename:=fso.GetParentFolderName(wb1.FullName) & "\" & fso.GetBaseName(wb1.FullName) & ".xlsx", FileFormat:=xlWorkbookDefault
wb1.Close
End Sub
###Powershellは別記事に
PowershellはPowershellではまる場所があった。
https://qiita.com/Q11Q/items/695c987d52c09b663ffc
上のPowershell版はcsvから直接読み込むときだけではなく、Excelに読み込むときも使えます。
QueryTableはアクセスから起動する
####手順0 設定
#####ファイルの場所
あるドライブにFileImportCsvがあります。
このファイルの場所は今から使うaccdbファイルと同じ場所にあります。
#####文字コード
文字コードはShift-jis ANSI CP932
#####項目（Field）名あり
項目名があります。
#####主キーになりうる列が1列目；列名ID
1列目はIDという名前で、この列には数字だけで、数字が入っていない行がなく、かつ、数字には重複がないとします。（ない場合にはIDに付与するコードはいりません）
#####これからやること
- これを一旦クエリーテーブルで読み込み、xlsxファイル形式に変換し、それをAccessのテーブルに入れます。
- IDという列を主キーに変換します。
####手順1Excelでマクロの自動記録
まずExcelでマクロの自動記録でQuerytableを作ります。
####Excelのマクロ自動記録の怪現象
とは言っても失敗するときがなんどもあると思います。このとき、接続を削除して作り直してください。
このときすぐ自動記録をしなおすのではなく、クエリーテーブルを削除してからやり直した方が良いです。
マクロに記録されているので、削除してもやり直せるからです。
https://tonari-it.com/excel-vba-csv-querytable-delete/
この連載はさんこうになりますが、特にここが重要です。
しかし
'.CommandType = 0の列は必ず無効化してください。
という怪現象はないですね。これはマクロに記録されるのですが、再度実行するとエラーになるのです。
####Array情報はOpenTextと同じらしい
基本的に1，2,5しか使いません。
わからないときは2にして様子を見ます。
2が文字列で一番エラーが起きません。1が標準、型は自動判定。5は日付です。yyyy/mm/dd
数字は全部1にすると長いコードが指数表示になります。
このため、文字列型が有利です。
また、最初の数行にデータが埋まっていた方が自動判定がききます。
この自動記録でテーブルのデータ型情報を取得して定義しているわけです。
一種のスキーマの作成です。実際この設定項目はExcel独自のGeneralをのぞきスキーマです。OpenTextにも近いですが。Excelは日付の形式にやたら細かいです。
####アクセスに移植
これは定数や変数を加えてください。
基本的に出来上がったコードのうちWith ActiveSheet.QueryTables.Add("からEnd WIthまでをコピーし
With QTに変えます。あと定数を基本的なものだと1に変更します。
Sub CSVImport()
'For Microsoft Access (Not For Excel)
Const acSpreadsheetTypeExcel12 = 9
Const acSpreadsheetTypeExcel12Xml = 10
Const xlInsertDeleteCells = 1
Const xlTextQualifierDoubleQuote = 1
Const xlDelimited = 1
Const TName = "ImportTableName"
Const csvImportFile = "FileImport.Csv"
Dim xlAPP: Set xlAPP = CreateObject("Excel.Application"): xlAPP.Visible = True 'VisibleにしないとActivateが効かない
Dim i As Long
Dim wb 'As Workbook
Set wb = xlAPP.Workbooks.Add
Dim ws 'As Worksheet
Dim QTS 'As Excel.QueryTables
Dim QT 'As QueryTable
Set ws = wb.ActiveSheet
Dim cDB As DAO.Database: Set cDB = CurrentDb
Dim fld As DAO.Field
Dim flid As DAO.Field
Dim TDf As DAO.TableDef
Dim prp As DAO.Property
Dim prps As DAO.Properties
Dim idx As DAO.Index
Dim idxs As DAO.Indexes
Set ws = wb.ActiveSheet
wb.Activate
'CSVファイルをOpenTextで取り込むとき、自動記録を使うと項目数が多いと、Array(1,2)...のように項目数が多いため、行継続文字が24を超えてエラーになる。クエリ—テーブルだと数字しかないので、かなりの数が入る。
Set QTS = ws.QueryTables
'Set QTのファイル名は変更すること
Set QT = QTS.Add(Connection:="TEXT;" & Drive & ":\" & csvImportFile, Destination:=ws.Range("$A$1"))
'Withのあとは QTに変える。
With QT
'.CommandType = 0 ’エラーになるのでコメントアウトすること
.Name = "CsvImportFile_1" 'ここはマクロの自動記録で生成されたシート名で良い
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False ’ここはFalseにすること
.RefreshStyle = 1 'xlAPP.XlCellInsertionMode.xlInsertDeleteCells この定数は1にする
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 932 ’文字列コードはUTF-8だと65001
.TextFileStartRow = 1 ’ここで読み込み開始行を指定できる。
.TextFileParseType = 1 ' xlAPP.XlTextParsingType.xlDelimited この定数は1にする
.TextFileTextQualifier = 1 ' xlAPP.XlTextQualifier.xlTextQualifierDoubleQuote この定数は1にする
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 2, 2, 5, 2, 2, 1, 1, 2, 1, 1, 1, 1, 1, 2, 1, 2, 1, 2, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 5, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 5, 2, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 5, 5, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 2, 2, 1, 1, 2, 1, 1, 2, 5, 1, 1, 1, 1, 5, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 5, 2, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 5, 1, 1, 1, 1, 1, 1
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False ’ここはFalseにすること
End With
'同名のファイルがあると失敗するため削除する
With CreateObject("Scripting.Filesystemobject")
If .FileExists(CurrentProject.Path & "import.xlsx") = True Then .deletefile CurrentProject.Path & "import.xlsx"
End With
wb.SaveAs CurrentProject.Path & "import.xlsx"
wb.Close
Set wb = Nothing
xlAPP.Quit
'同名のテーブルがあると失敗するため削除する
For Each TDf In cDB.TableDefs
If TDf.Name = TName Then
DoCmd.SetWarnings False
DoCmd.DeleteObject acTable, TName
DoCmd.SetWarnings True
Exit For
End If
Next
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, TableName:=TName, FileName:=CurrentProject.Path & " import.xlsx", hasfieldnames:=True 'なぜか小文字になる
DoEvents
cDB.TableDefs.Refresh: DoEvents
Application.RefreshDatabaseWindow: DoEvents
Set TDf = cDB.TableDefs(TName)
'以下はID列に主キーを付与しない場合はいらない。
' http://www.accessclub.jp/dao/21.html
Set idx = TDf.CreateIndex("Get_ID")
idx.Primary = True 'これをつけないと主キーにならない
TDf.Indexes.Refresh
Set flid = idx.CreateField("ID")
idx.Fields.Refresh
idx.Fields.Append flid
TDf.Indexes.Append idx
TDf.Indexes.Refresh
cDB.TableDefs.Refresh
''主キーを付与しない場合はここまで削除して良い。
End Sub