| |
こんばんは。
本当はね、サンプルデータは、この命題用に初心者さんが用意するのですよ！！
新規ブックにて、
標準モジュール(Module1）にサンプル作成プロシジャー
'=======================================================
Sub mk_sample_csv()
Dim fno As Long
fno = FreeFile()
Open ThisWorkbook.path & "\csvtest.csv" For Output As #fno
Print #fno, "12345678901234567890,ichinose-A"
Print #fno, "12345678901234567891,ichinose-B"
Print #fno, "12345678901234567892,ichinose-C"
Close #fno
End Sub
＊＊ 最初に上記のコードをコピーして、一度適当なフォルダに保存してください
↑これ重要
保存後に、上記のmk_sample_csvを実行してください。
VBAコードを含んだブックと同じフォルダ上に csvtest.csv というファイルが作成されます。
中身は、
12345678901234567890,ichinose-A
12345678901234567891,ichinose-B
12345678901234567892,ichinose-C
こんなcsvファイルです。
このファイルを 初心者さんが提示されたコードを参考にした
'===============================================
Sub test1()
Dim con As Object
Dim rs As Object
Set con = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
Dim connectionString As String
connectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source= " & ThisWorkbook.path & "\" & ";" & "Extended Properties=""Text;HDR=NO;FMT=Delimited"""
con.Open connectionString
Set rs = con.Execute _
("SELECT * FROM csvtest.csv;")
Range("a1").CopyFromRecordset rs
rs.Close
con.Close
End Sub
上記のtest1を実行すると、アクティブシートのＡ列の書式を文字列にしても
Ａ Ｂ
１ 1.23457E+19 ichinose-A
２ 1.23457E+19 ichinose-B
３ 1.23457E+19 ichinose-C
このように表示されてしまいます。
同ブックの別の標準モジュール（Module2）にAdoでテキスト操作関連プロシジャー群
忘れるほど前に作っておいたやつ（仕事では、使ったことがない）。
Option Explicit
'=============================================================
Private cn As Object
'=============================================================
Function open_ado_text(path As String) As Long 'adoでテキストにアクセス
On Error Resume Next
Dim link_opt As String
Set cn = CreateObject("adodb.connection")
link_opt = "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
"DBQ=" & path & ";" & "ReadOnly=0"
cn.Open link_opt
open_ado_text = Err.Number
On Error GoTo 0
End Function
'=============================================================
Sub close_ado() 'クローズ
On Error Resume Next
cn.Close
On Error GoTo 0
End Sub
'=============================================================
Function exec_sql(sql_str, rs As Object) As Long 'Sqlの実行
On Error Resume Next
Set rs = cn.Execute(sql_str)
exec_sql = Err.Number
If Err.Number <> 0 Then MsgBox Err.Description
On Error GoTo 0
End Function
'==========================================================================
Function mk_schema_ini(path As String, dat() As String) As Long 'schema.iniの作成
On Error GoTo err_mk_schema_ini
Dim fno As Long
Dim didx As Long
mk_schema_ini = 0
fno = FreeFile()
Open path & "\schema.ini" For Output As #fno
For didx = LBound(dat()) To UBound(dat())
Print #fno, dat(didx)
Next
Close #fno
ret_mk_schema_ini:
On Error GoTo 0
Exit Function
err_mk_schema_ini:
MsgBox Err.Description
mk_schema_ini = Err.Number
Resume ret_mk_schema_ini
End Function
'=============================================================
Function del_schema_ini(path As String) 'schema_iniの削除
On Error Resume Next
Kill path & "\schema.ini"
On Error GoTo 0
End Function
別の標準モジュ−ル（Module3）に
'=================================================================
Sub main()
Dim ret As Long
Dim dat(1 To 6) As String
Dim rs As Object
Dim ans As Variant
dat(1) = "[csvtest.csv]"
dat(2) = "ColNameHeader = False"
dat(3) = "CharacterSet = oem"
dat(4) = "Format = CSVDelimited"
dat(5) = "Col1=f1 char width 255"
dat(6) = "Col2=f2 char width 255"
Call mk_schema_ini(ThisWorkbook.path, dat())
ret = open_ado_text(ThisWorkbook.path)
If ret = 0 Then
ret = exec_sql("select * from csvtest.csv;", rs)
If ret = 0 Then
With ActiveSheet
.Columns(1).NumberFormatLocal = "@"
.Range("a1").CopyFromRecordset rs
End With
rs.Close
Else
MsgBox Error(ret)
End If
close_ado
End If
Call del_schema_ini(ThisWorkbook.path)
End Sub
これでmainを実行してみてください。
今度は、全部の数字が表示されるはずです。
要は、schema.iniというファイルに各フィールドの型を規定してやる方法です。
表示された数字を計算に使いたいなら、Cdec関数で、10進型に変換して計算してください。
ここでは、初心者さんより、VBAの知識のない方でも
初心者さんが抱えている問題にまで到達できる記述を心がけてみてください。
↑これをすることは、間違いなく役に立ちます、プログラミングには・・。
|
|
ichinose
- 11/10/20(木) 22:30 -
