[pgsql-jp: 38822] Excel VBA + ODBC接続でデータ取得で、先頭１桁を返す場合がある？

[藤澤]

藤澤です。

Excel2003(VBA)から、PostgreSQL 8.2.4 にODBC接続して、
値を取り出したいと考えています。
が、フィールドから値を取り出した時、先頭の１桁しか取得できない
場合があります。(※)


□データ
    c1  c2  c3
    --  --  -----------
    01  01  ABCDE
    11  01  FGHIJK
    A1  01  FGHIJK
    AB  01  FGHIJK

□Excelへの出力結果
    0   0   ABCDE
    1   0   FGHIJK
    A   0   FGHIJK
    A   0   FGHIJK

※c1, c2 は先頭の１桁しか取得できていません。
  c3 はちゃんと取得できています。


どなたか情報をお持ちの方がいらっしゃいましたら、教えてください。
以上、よろしくお願いします。



以下、データ、Excel(VBA)のソース、環境等です。

■テーブルとデータの作成
hoge=> create table t1 (
hoge(>   c1 varchar(2),
hoge(>   c2 varchar(2),
hoge(>   c3 varchar(20)
hoge(> );
CREATE TABLE
hoge=>
hoge=> INSERT INTO t1 VALUES ('01', '01', 'ABCDE');
INSERT 0 1
hoge=> INSERT INTO t1 VALUES ('11', '01', 'FGHIJK');
INSERT 0 1
hoge=> INSERT INTO t1 VALUES ('A1', '01', 'FGHIJK');
INSERT 0 1
hoge=> INSERT INTO t1 VALUES ('AB', '01', 'FGHIJK');
INSERT 0 1



■VBA のソース (標準モジュール)
□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□
Option Explicit

Private WS      As Workspace    'ワークスペース
Private DB      As Connection   'ＤＢコネクション
Private RS      As Recordset    'レコードセット



Public Sub psubMyQuery()
    Dim strDsn  As String
    Dim strUid  As String
    Dim strPwd  As String
    Dim strKaishaCd  As String
    Dim i As Long
    
    '------------------
    '- Initial Logic
    '------------------
    On Error GoTo PROC_ERR
    
    '表示データのクリア
    Sheets("Data").Select
    Range(Cells(6, 2), Cells(100, 11)).Value = ""

    '設定内容の取得  (Dsn,Uid,Pwd)
    'Dsn (データソース名)
    strDsn = Trim(Sheets("Setting").Cells(4, 4))
    'Uid (接続ユーザ)
    strUid = Trim(Sheets("Setting").Cells(5, 4))
    'Pwd (パスワード)
    strPwd = Trim(Sheets("Setting").Cells(6, 4))
    
    '------------------
    '- Main Logic
    '------------------
    'データベースのオープン
    If OpenDB(strDsn, strUid, strPwd) Then
        Exit Sub
    End If
            
    '実行 (データ取得＋シートへの出力)
    Call msubSetData(strKaishaCd)
    
    'データベースのクローズ
    If CloseDB Then
        Exit Sub
    End If
    
    '------------------
    '- Terminal Logic
    '------------------
    MsgBox "処理が正常に終了しました。"
    Exit Sub

'------------------
'- Error Logic
'------------------
PROC_ERR:
    On Error Resume Next
    
    Call CloseDB
    MsgBox "エラーが発生しました。" & vbCrLf & vbCrLf & Err.Number & "  :  " & Err.Description
    
End Sub


' Open
Private Function OpenDB( _
        ByVal vstrDSN As String, _
        ByVal vstrUID As String, _
        ByVal vstrPWD As String _
) As Boolean
    On Error GoTo ProcErr
    
    Set WS = DBEngine.CreateWorkspace("", "", "", dbUseODBC)
    Set DB = WS.OpenConnection("", dbDriverNoPrompt, False, "ODBC;DSN=" & vstrDSN & ";UID=" & vstrUID & ";PWD=" & vstrPWD)
    DB.QueryTimeout = 1000
    OpenDB = False
    Exit Function

ProcErr:
    MsgBox "エラーが発生しました。" & vbCrLf & vbCrLf & Err.Number & "  :  " & Err.Description
    OpenDB = True
End Function


' Close
Private Function CloseDB() As Boolean
    On Error GoTo ProcErr
    
    DB.Close
    WS.Close
    Set RS = Nothing
    Set DB = Nothing
    Set WS = Nothing
    CloseDB = False
    Exit Function

ProcErr:
    MsgBox "エラーが発生しました。" & vbCrLf & vbCrLf & Err.Number & "  :  " & Err.Description
    CloseDB = True
End Function


' データ取得
Private Sub msubSetData(ByVal vstrKaishaCd As String )
    Dim strSql As String
    Dim iRow    As Integer
    
    '------------------
    '- Initial Logic
    '------------------
    On Error GoTo ProcErr
    
    '------------------
    '- Main Logic
    '------------------
    strSql = ""
    strSql = strSql & "SELECT c1, c2, c3 FROM t1" & vbCrLf
    Debug.Print "strSql = "
    Debug.Print strSql
    
    Set RS = Nothing
    Set RS = DB.OpenRecordset(strSql, dbOpenDynamic)
    iRow = 6
    
    Do While Not (RS.EOF)
        Cells(iRow, 3) = RS("c1")
        Cells(iRow, 4) = RS("c2")
        Cells(iRow, 5) = RS("c3")
        
        iRow = iRow + 1
        RS.MoveNext
    Loop

    '------------------
    '- Terminal Logic
    '------------------
    Exit Sub

'------------------
'- Error Logic
'------------------
ProcErr:
    MsgBox "エラーが発生しました。" & vbCrLf & vbCrLf & Err.Number & "  :  " & Err.Description
End Sub

□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□



■環境
------------------------------------
ホスト「hoge3」
    Windows Server 2003 SP2
    PostgreSQL 8.2.4
    データベース名  hoge3 (UTF-8)
    接続ユーザ名    hoge
    パスワード      hogehoge

クライアント
    Windows XP (SP2)
    Excel 2003
    PostgreSQL 8.2.4  (データベースもクライアントも導入)
      * ODBCドライバ … PostgreSQL Unicode  8.02.03.01
------------------------------------



／藤澤