• 締切済み

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 ーーーーーーーーーーーーーーーーーーーーーー

みんなの回答

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.1

SAPという言葉を初めに出して、質問すれば、回答は出ないのではないかと 予想した。こういうコーナーを見ていて、SAPの回答をできる人は、いないだろう。 世の中のこのコーナーの読者の層を想像して、質問表現をを工夫すべきだ。 また実際はエクセルVBAの質問ではないのか。 SAPからエクセルへのデータを持ってくるのは、特有の橋渡しのメッソッドなどが 要るでしょうが。 SAPを利用できているということは、勤務先が相当なお金を払っているはず。 SAPやそのパートナー企業は、相談員(カスタマエンジニア?)がいて、教えて くれるのではないか。質問者は会社のシスエム部の担当者でなく、依頼ができないのかな? あるいはSAPのSEの人もエクセルVBAなどは詳しいとは限らないかも。 SAPではないが,昔にExcelなんてというSEもいたが。 本件は、質問者ができるエクセルのシートにデータを落として、データ選別まがいのことを して、エクセルシートデータを作りたいのだろうが、エクセルVBAも詳しいのかな。 ーー SQLの例が出ているが、エクセルのシートデータになれば、シートの各行を順次 読んで、望みの項目に対しIF文で聞いて選別すれば済むことではないか? SAPデーターー>エクセルシートデータへは、プログラムで達成しているのですね。 (=質問のコードの前半はうまく行っているのですね)ここで前半処理と後半処理を 切り分けられると思う。 後半でSQLを使ってシートデータを別シートに選別できれば良いのでは。 ーー その後半のエクセルデータをSQLで選別するのは、余りVBAではやらないようだが、 (エクセルでは、IF文で選別やFilterなどもあるから。)SQLのように 集合処理ではなく、レコード処理(各行処理)がしやすい。 SQLが背後で動いているようなのは (1)MSクエリを使う (2)ADOでSQLを使う (3)Accessへデータを渡して(エクセルからでも簡単)、クエリを使う (うらではSQLが動いているようだ) などが考えられると思った。 ーー 前記の(2)のことを考えて、WEB照会して、下記のようなものが見つかったので 参考までに上げてみます。 WEBに記事はあってもコピペ程度で実行すると(やる人の力不足っで)うまく行かない場合が 多いので、多分そのままコピペで動くコードを上げてみる。。 (1)エクセルデータはWEBより住所録を借用して、その右列に住所の府県コードを 入れた。 ファイル名 住所録例.xlsx Sheet1 ID 名前 フリガナ 郵便番号 住所 電話番号 府県コード 1 伊藤 武 イトウ タケシ 612-8324 京都府京都市伏見区小豆屋町 075-5**-**** 1 2 井上 勝 イノウエ マサル 665-0014 兵庫県宝塚市青葉台 0797-8*-**** 2 3 榎本 幸治 エノモト コウジ 583-0842 大阪府羽曳野市飛鳥 0729-5*-**** 3 4 太田 博 オオタ ヒロシ 560-0015 大阪府豊中市赤阪 06-68**-**** 3 5 萱島 真 カヤシマ マコト 569-1146 大阪府高槻市赤大路町 0726-9*-**** 3 6 木下 宏道 キノシタ ヒロミチ 598-0014 大阪府泉佐野市葵町 0724-6*-**** 3 7 久部 明弘 クベ アキヒロ 541-0052 大阪府大阪市中央区安土町 06-67**-**** 3 8 児玉 智弘 コダマ トモヒロ 600-8071 京都府京都市下京区相之町 075-3**-**** 1 9 綾野 亜希 アヤノ アキ 573-0026 大阪府枚方市朝日丘町 072-84*-**** 3 10 江本 綾子 エモト アヤコ 545-0000 大阪府大阪市阿倍野区 06-67**-**** 3 11 岡田 優梨子 オカダ ユリコ 675-0026 兵庫県加古川市尾上町旭 0794-2*-**** 2 12 加藤 裕美 カトウ ユミ 631-0053 奈良県奈良市青垣台 0742-4*-**** 4 13 河野 恵美子 コウノ エミコ 601-1394 京都府宇治市池尾 0774-3*-**** 1 14 斎藤 美恵 サイトウ ミエ 532-0031 大阪府大阪市淀川区加島 06-63**-**** 3 15 篠原 信子 シノハラ ノブコ 591-8007 大阪府堺市北区奥本町 0729-3*-**** 3 16 田中 裕子 タナカ ユウコ 662-0063 兵庫県西宮市相生町 0798-6*-**** 2 (2)エクセルのVBE画面で、 ツールー参照設定 Microsoft Office 15.0 Object Library Microfoft Active Data Objects 2.8 library にチェックを入れて参照設定を行う。 (3)下記コードを、標準モジュールにコピペ ーーーー Sub ExcelにADO接続() 'パスワード付きのエクセルファイルに接続する Dim myCon As New ADODB.Connection, FileName As String, myPass As String Dim conStr As String '接続先のExcelファイルとパスワード MsgBox ThisWorkbook.Path FileName = ThisWorkbook.Path & "\" & "住所録例.xlsx" myPass = "password" 'エクセルファイルを開く (ファイルが開かれていないと接続できない) Workbooks.Open FileName, Password:=myPass '接続文字列 conStr = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Extended Properties=Excel 8.0;" & _ "Data Source=" & FileName '接続 myCon.Open conStr MsgBox "Excelブックに接続完了!" '--- ' SQL文作成 Dim strSQL As String Dim dbRes 'strSQL = "SELECT * FROM [Sheet1$]" ' ←単純に全件転記ならこの記述 strSQL = "SELECT * FROM [Sheet1$] WHERE 府県コード=3 ORDER BY フリガナ;" ' RecordSet取得(表示用) Set dbRes = New ADODB.Recordset dbRes.CursorLocation = adUseClient dbRes.Open strSQL, myCon, adOpenDynamic, adLockOptimistic, adCmdText ' シートクリア Cells.ClearContents '--------------------------------------------------------------------------- ' 見出し作成(普通は要らない!) Dim col For col = 1 To dbRes.Fields.Count Cells(1, col).Value = dbRes.Fields(col - 1).Name Next col '--------------------------------------------------------------------------- ' 明細のセット 'Cells(2, 1).CopyFromRecordset dbRes ' ←単純に全件転記ならこの記述でOK! Dim GYO GYO = 1 Do Until dbRes.EOF GYO = GYO + 1 For col = 1 To dbRes.Fields.Count Cells(GYO, col).Value = dbRes.Fields(col - 1).Value Next col dbRes.MoveNext Loop ' 終了 dbRes.Close: Set dbRes = Nothing myCon.Close: Set myCon = Nothing '--- '接続を解除し、オブジェクトをクリア 'myCon.Close: Set myCon = Nothing 'Excelブックを閉じる Workbooks("住所録例.xlsx").Close End Sub ーーーー (4)実行 結果はSheet2に下記の通り。 府県コード「2}(大阪府)を抜き出し ID 名前 フリガナ 郵便番号 住所 電話番号 府県コード 9 綾野 亜希 アヤノ アキ 573-0026 大阪府枚方市朝日丘町 072-84*-**** 3 3 榎本 幸治 エノモト コウジ 583-0842 大阪府羽曳野市飛鳥 0729-5*-**** 3 10 江本 綾子 エモト アヤコ 545-0000 大阪府大阪市

関連するQ&A

  • Excel VBAでXML形式のデータを扱いたい

    SQL ServerにXML形式のデータが"1つのカラムにロングテキスト(ntext)形式で格納"されています。 このデータをExcelのVBAで取得したのは良いのですが、XML文書からタグを指定して任意の値を取得する方法がわかりません。 とりあえず以下のように普通の取得をするまでは書いてみました。 --- Sub GetXMLDataFromSQLServ() Dim CNN As ADODB.Connection Dim RST As ADODB.Recordset Dim RecCt As Long Dim strCNN As String Dim strData1 As String Dim strData2 As String Dim xmlTest As MSXML2.DOMDocument 'Connection String strCNN = "driver={SQL Server}; server=appdemo; uid=userid; pwd=password; database=database" Set CNN = New Connection CNN.ConnectionTimeout = 30 CNN.Open strCNN 'レコードセットを開く Set RST = New ADODB.Recordset RST.CursorType = adOpenStatic RST.Open "SELECT * FROM G_JOB_CONTENT;", strCNN RST.MoveFirst 'シートに出力 Do Until RST.EOF ActiveCell.Value = RST.Fields("JOB_ID") ActiveCell.Offset(0, 1).Value = RST.Fields("XML") '---(1) RST.MoveNext ' ActiveCell.Offset(1, 0).Activate Loop 'レコードセットを閉じる Set RST = Nothing '接続を閉じる Set CNN = Nothing End Sub --- (1)の部分でXMLのタグを指定し、任意のデータを得たいと考えています。 参照設定などを見て、おそらくMSXML2オブジェクトを使うのかな、というところまでは想像ついたのですけど・・・。 どなたかご教示の程をお願いいたします。

    • ベストアンサー
    • XML
  • データ型をメモ型にして既存テーブルにフィールドを追加したい(ACCESS ADOX)

    Sub test() Dim cat As New ADOX.Catalog Dim tb As New ADOX.Table cat.ActiveConnection = CurrentProject.Connection 'テーブルを開く Set tb = cat.Tables("テーブル1") tb.Columns.Append "フィールド1", ad○○ Set cat = Nothing Set tb = Nothing End Sub これで既存のテーブルにフィールドを追加できることを知ったのですが データ型をメモ型にするにはどの「ad○○」にすればいいのでしょう? (文字数が多いためテキスト型では収まりません) オブジェクトブラウザで見ても、多すぎてどれなのかわかりません。 ご教授よろしくお願い致します。

  • エクセルvba

    エクセルvbaなのですが Sub test() Dim xlApp As Object Dim xlBook As Object Set xlApp = CreateObject("Excel.Application") Set xlBook = xlApp.Workbooks.Open(ActiveWorkbook.FullName) 'コード・・・ Set xlApp = Nothing Set xlBook = Nothing End Sub これだと Set xlBook = xlApp.Workbooks.Open(ActiveWorkbook.FullName) の部分で、エラーになります。 実行時エラー1004です。 自身ファイルをオブジェクトに格納して操作したいのですがどうすればいいでしょうか?

  • Access2000のVBAで上書き更新

    お世話になります。 Access2000のVBAで作成しております。 Excelに記載した情報をAccessのテーブルに 取り込むために下記のソースを作成致しました。 既にテーブルに主キーが重複しないものを取り込むときは 正常に処理が走るのですが、 主キーが重複する場合は、重複する旨メッセージを出して 処理が止まります。 どのようにソースを修正すれば、「主キーが重複する場合、上書き更新」 するように処理が走るのでしょうか? 以上宜しくお願い致します。 --------------ソース------------------------------ Dim rs As New ADODB.Recordset Dim oApp As Object Dim iRow As Long Set oApp = CreateObject("Excel.Application") oApp.Workbooks.Open Filename:="hogehoge.xls" rs.Open "テーブル", CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic iRow = 2 ' ★ While( ループ )   rs.AddNew   rs("ID") = oApp.Cells(iRow, 1)   rs("名前") = oApp.Cells(iRow, 2)   rs.Update   iRow = iRow + 1 Wend rs.Close oApp.Quit Set oApp = Nothing

  • アクセスVBA。ADO

    CSVから列を分割してテーブルにしたいかったので 下記のコードを記述しましたが、 Dim cn As ADODB.Connection Dim rs As New ADODB.Recordset Dim datacount As Long Set cn = New ADODB.Connection With cn .ConnectionString = "Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & CurrentProject.Path & "\;" .Properties("Extended Properties").Value = "text;HDR=YES;" .Open End With Set rs = cn.Execute("SELECT * FROM 構成マスタ.csv") datacount = rs.Fields.Count For i = 0 To datacount strsql = "SELECT " & rs.Fields(i).Name & " INTO " & rs.Fields(i).Name & " FROM 構成マスタ.csv;" cn.Execute strsql Next i rs.Close cn.Close Set rs = Nothing Set cn = Nothing SQLを実行するところで、「日付エラー」となってしまいます。 データには特に日付等はないのでエラーになる原因がわかりません。 どなたかご教示いただけますでしょうか。

  • VBAでテーブル名とカラム名を動的に取得したい。

    お世話になります。 VBAでMySQLに接続をし、DB操作をするものを作成しています。 ・Windows7 ・エクセル2007 ・MySQL 5.1 ・ODBC そこで、以下のことをしたいと思っています。 (1)ある特定のデータベースの中にあるテーブル名を全取得 (2)そのテーブル名を変数または配列に格納 (3)そのテーブル名をキーに、今度はフィールド名を全取得 私が組んでみた該当のソースの部分は、   Dim aaa As New ADODB.Recordset   strSql = "show tables from testdb;"   Set aaa = con.Execute(strSql) 'conはADODB.connection Dim j As Integer For j = 1 To aaa.Fields.Count MsgBox aaa.Fields(j -1).name Next ・・・とここまで来ました。 show tables from databaseで、データベースにあるテーブルを取得して、 aaa.Fields(j -1).nameには「Tables_in_testdb」が入ります。 その次に、もう消してしまったので無いのですが、 msgbox aaa.Fields("Tables_in_testdb")?とやってみたところ、 データベースに入っている一つのテーブル名だけしか取得できませんでした。 ソースが回りくどい気がする+テーブル名が取得出来ず、 大分煮詰まっています。。。 何かもっとうまい書き方や構文(サンプル)ありましたら教えてください!!!

  • エクセルVBAでエラー!

    エクセルでVBAを組んでいます。 Aシート・Bシートにデータがあり、それをSQLで集計し、 Cシートに出力をしたいのですが、 『リンクされているExcelのワークシートを表示するための接続が切断されました。』 というエラーが出て、解決しません。 (調べてみましたが、似たような例がなく解決には至りませんでした・・・。) どなたかご教示お願い致します。 Private Sub CommandButton1_Click() Dim dbCon As Object Dim dbCols As Object Dim dbRes As Object Dim strSQL As String Dim sh1 As Worksheet Set sh1 = Worksheets("Cシート") Set dbCon = CreateObject("ADODB.Connection") dbCon.Provider = "Microsoft.Jet.OLEDB.4.0" dbCon.Properties("Extended Properties") = "Excel 8.0" dbCon.Open ThisWorkbook.FullName strSQL = "" strSQL = strSQL & "SELECT *" strSQL = strSQL & vbCrLf & "FROM [Aシート$] LEFT JOIN [Bシート$] ON [Aシート$].NO= [Bシート$].NO" Set dbRes = CreateObject("ADODB.Recordset") dbRes.Open strSQL, dbCon, adOpenKeyset, adLockReadOnly sh1.Range("A1").CopyFromRecordset dbRes dbRes.Close Set dbRes = Nothing dbCon.Close Set dbCon = Nothing End Sub

  • VBAでのSQL文によるエラー

    よろしくお願いします。 現在VBAでMySQLに接続し、複数のselect文を実行した結果をcsv出力したいのですが、 select文にinto outfileを入れると、 「オブジェクトが閉じている場合は、操作できません」のようなメッセージが出てしまいます。 普通のselectや、where付のselectに変えたところ、このエラーは出ませんでした。 以下サンプルコードです。 Dim cnct As ADODB.Connection Dim slct01 As ADODB.Recordset Dim slct02 As ADODB.Recordset Dim cnstSTR As String Dim sql01 As String Dim sql02 As String '接続文字列 cnstSTR = "Driver={MySQL ODBC 5.1 DRIVER};"・・・(←接続文字列は省きます) Set cnct = New ADODB.Connection cnct.Open cnstSTR Set rs = cnct.Execute("select * from table01 into outfile " & "'C:/test/test01.csv'" & " FIELDS TERMINATED BY ',';"")←ここ Set ds = cnct.Execute("select * from table2" into outfile " & "'C:/test/test02.csv'" & " FIELDS TERMINATED BY ',';"") 'テーブルのクローズ slct01.Close slct02.Close 'データベースのクローズ cnct .Close Set slct01= Nothing Set slct02= Nothing Set cnct = Nothing やはりinto outfileが原因でしょうか。。。 ソースの修正や、csv出力で他にいい方法あったら教えてください!! よろしくお願いします!!!

  • ADOでエクセルからSQL Serverへデータを移行するには

    エクセルvbaのADOを使って、 SQL Serverの「test」という名のデータベースの「Table_1」に 新規レコードを追加する事はできますか? エクセルからアクセスには Sub test() Dim データベース名 As String Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Set cn = New ADODB.Connection Set rs = New ADODB.Recordset cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & データベース名 rs.Open "Tテーブル1", cn, adOpenKeyset, adLockOptimistic rs.AddNew rs.Fields("フィールド1") = データ rs.Update rs.Close cn.Close Set rs = Nothing Set cn = Nothing End Sub で移行しています。 これをエクセルからSQL Serverへ移行させるにはどうすればいいのでしょうか? よろしくお願いします。

  • Access ADP テーブル 説明欄を取得したい

    大変お世話になります。 Access 2007 ADPファイルにて SQL Server 2005 との接続でのシステムを運用しています。 テーブル情報のフィールド説明欄(Description) の値の一覧を取得したいと思い下記のプログラムを作ってみたのですが、Descriptionの値以外はおおむね取得できるのですが、説明欄のところがすべてエラーになってしまい説明欄の Description の取得ができません。 格納場所か、プロパティの参照の仕方が原因だと思うのですが、解決できません。 テーブルの説明欄(Description)値の参照の仕方をご存じの方がいらっしゃいましたら何卒ご教授いただければと存じます。 よろしくお願いいたします。     Dim Cn As ADODB.Connection     Dim Rs As New ADODB.Recordset     Dim SQL As String     Dim i As Integer          Set Cn = CurrentProject.Connection          SQL = " SELECT dbo.テーブルA.* "     SQL = SQL & " FROM dbo.テーブルA"     Dim MyDB As New ADOX.Catalog     Dim MyTable As ADOX.Table     Dim MyField As ADOX.Column     MyDB.ActiveConnection = CurrentProject.Connection     Set MyTable = MyDB.Tables("テーブルA")          Rs.Open SQL, Cn, adOpenForwardOnly, adLockReadOnly         For i = 0 To Rs.Fields.Count - 1             MsgBox Rs.Fields(i).Name                                     'MsgBox MyTable.Columns(Rs.Fields(j).Name).Properties("Description").Value             MsgBox Rs.Fields(i).Properties("Description").Value             MsgBox Rs.Fields(i).ActualSize             MsgBox Rs.Fields(i).Attributes             'MsgBox Rs.Fields(i).DataFormat             MsgBox Rs.Fields(i).DefinedSize             MsgBox Rs.Fields(i).NumericScale             'MsgBox Rs.Fields(i).OriginalValue             MsgBox Rs.Fields(i).Precision                          'MsgBox Rs.Fields(i).Properties("Description")                                      MsgBox Rs.Fields(i).Status             MsgBox Rs.Fields(i).Type             'MsgBox Rs.Fields(i).UnderlyingValue             MsgBox Rs.Fields(i).Value                  Next     Set MyDB = Nothing     Rs.Close     Set Rs = Nothing     Cn.Close     Set Cn = Nothing     Exit Sub

専門家に質問してみよう