SAPデータ取得 エクセルVBA
いつもここでお世話になっております。
次のサイトで掲載されていたVBAで、SAPのデータ(テーブルデータ)をエクセルで取得することができることがわかりましたが、例えばですがSQLを利用するようなVBAを追記して、任意のフィールド、任意のデータを指定して、それに合致するものだけをエクセルに表示させることはできないでしょうか(イメージとして、SELECT フィールド FROM QUERY_TABLE WHERE データのような感じ)。
何度も試行錯誤をしたのですが、うまくいきません。なにとぞよろしくお願い申し上げます。
※SAPテーブル取得のエクセルVBA : http://d.hatena.ne.jp/sikakura/20100702/1278053742
-ーーー【以下、テーブルデータ取得のためにVBA】----
Sub ログインR3_LOGON()
Set R3 = CreateObject("SAP.Functions")
'R3.Connection.System = "172.31.220.42"
'R3.Connection.client = "100"
'R3.Connection.User = "SAP*"
'R3.Connection.Password = ""
'R3.Connection.Language = "EN"
'自動ログインする場合は、Connection.Logon(0,True)にして、
'上のパラメータを設定すればOK.
If R3.Connection.Logon(0, False) <> True Then
MsgBox "ログインを中止しました"
Exit Sub
End If
'IMPORTパラメータ
Dim QUERY_TABLE As Object
Dim DELIMITER As Object
Dim NO_DATA As Object
Dim ROWSKIPS As Object
Dim ROWCOUNT As Object
'条件式
Dim OPTIONS As Object
Dim FIELDS As Object
'データ
Dim DATA As Object
'結果保持用
Dim ROW As Object
Dim Result As Boolean
Dim iRow, iColumn, iStart, iStartRow, iField, iLength As Variant
'*****************************************************
'RFC_READ_TABLEを指定します
'*****************************************************
Set MyFunc = R3.Add("RFC_READ_TABLE")
Set QUERY_TABLE = MyFunc.exports("QUERY_TABLE")
Set DELIMITER = MyFunc.exports("DELIMITER")
Set NO_DATA = MyFunc.exports("NO_DATA")
Set ROWSKIPS = MyFunc.exports("ROWSKIPS")
Set ROWCOUNT = MyFunc.exports("ROWCOUNT")
Set DATA = MyFunc.Tables("DATA")
Set OPTIONS = MyFunc.Tables("OPTIONS")
Set FIELDS = MyFunc.Tables("FIELDS")
QUERY_TABLE.Value = "CSKT"
DELIMITER.Value = " "
NO_DATA = " "
ROWSKIPS = 0
ROWCOUNT = 0
Result = MyFunc.Call
If Result = True Then
Set DATA = MyFunc.Tables("DATA")
Set FIELDS = MyFunc.Tables("FIELDS")
Set OPTIONS = MyFunc.Tables("OPTIONS")
Else
MsgBox MyFunc.EXCEPTION
Exit Sub
End If
'列名をExcelシートに出力
For iField = 1 To FIELDS.ROWCOUNT
Worksheets("Sheet2").Cells(1, iField).Value = FIELDS(iField, "FIELDTEXT")
Next
'データをExcelシートに出力
iField = 1
For iRow = 1 To DATA.ROWCOUNT
For iField = 1 To FIELDS.ROWCOUNT
iStart = FIELDS(iField, "OFFSET") + 1
iLength = FIELDS(iField, "LENGTH")
If iStart > Len(DATA(iRow, "WA")) Then
vField = Null
Else
vField = Mid(DATA(iRow, "WA"), iStart, iLength)
End If
Worksheets("Sheet2").Cells(iRow + 1, iField).Value = vField
Next
Next
' ****************************************************
' Release Object
' ****************************************************
Set MyFunc = Nothing
Set QUERY_TABLE = Nothing
Set DELIMITER = Nothing
Set NO_DATA = Nothing
Set ROWSKIPS = Nothing
Set ROWCOUNT = Nothing
Set OPTIONS = Nothing
Set FIELDS = Nothing
End Sub
Private Function Split(ByVal inp As String, Optional delim As String = ",") As Variant
Dim outarray() As Variant
Dim arrsize As Integer
While InStr(inp, delim) > 0
ReDim Preserve outarray(0 To arrsize) As Variant
outarray(arrsize) = Left(inp, InStr(inp, delim) - 1)
inp = Mid(inp, InStr(inp, delim) + 1)
arrsize = arrsize + 1
Wend
ReDim Preserve outarray(0 To arrsize) As Variant
outarray(arrsize) = inp
Split = outarray
End Function
ーーーーーーーーーーーーーーーーーーーーーー
お礼
ありがとうございます。 良いアドバイスだと思いましたが、一応、試してみましたが、うまくいきませんでした。 もう少し調べてみます。 情報ありがとうございました。
補足
連絡ありがとうございました。ただ、解決しなかったので、OSをWindowsServer2012にバージョンアップすれば問題は発生しませんでした。参考まで追記しておきます。