投稿‎ > ‎

VBAでODBC一覧を取得する

posted Dec 15, 2014, 9:42 PM by Zhang Wenxu
Public Function getODBCList() as String()
  Dim odbcList() As String
  Dim hEnv As Long
  Dim szDSN As String * 256
  Dim cbDSN As Integer
  Dim szDescription As String * 256
  Dim cbDescription As Integer
  Dim retCode As Integer
  Dim msg1 As String

  retCode = SQLAllocEnv(hEnv)
  If retCode < 0 Then
      MsgBox "HENVの取得に失敗しました。"
      Exit Function
  End If
  retCode = SQLDataSources(hEnv, SQL_FETCH_FIRST, szDSN, 256, cbDSN, szDescription, 256, cbDescription)
  If retCode < 0 Then
    MsgBox "SQLDataSourcesの呼び出しエラー！"
    Exit Function
  End If

  ReDim odbcList(1)
  odbcList(UBound(odbcList) - 1) = LeftB(szDSN, InStrB(szDSN, Chr$(0)) - (InStrB(szDSN, Chr$(0)) Mod 2))

  While retCode >= 0
     retCode = SQLDataSources(hEnv, SQL_FETCH_NEXT, szDSN, 256, cbDSN, szDescription, 256, cbDescripion)
     if retCode = SQL_NO_DATA_FOUND Then GoTo END1
     ReDim Preserve odbcList(UBound(odbcList) + 1)
     odbcList(UBound(odbcList) - 1) = LeftB(szDSN, InStrB(szDSN, Chr$(0)) - (InStrB(szDSN, Chr$(0)) Mod 2))
   Wend
END1:
  retCode = SQLFreeEnv(hEnv)
  getODBCList = odbcList
End Function

Comments