2016-06-30 1 views
1

엑셀 스프레드 시트에서 웹 쿼리를 수행하고 싶습니다. 그러나 워크 시트에 데이터를 표시하고 싶지 않습니다. VBA 배열에 직접 저장하고 싶습니다. 엑셀 스프레드 시트 셀 대신 VBA 변수로 웹 쿼리 데이터 가져 오기

나는 인터넷 Return Sql Query Results To Vba Variable Instead Of Cell

다음

ODBC 연결과 링크에서 코딩 솔루션에이 예제를 발견했다. 나는 이것을 웹 쿼리 솔루션에 적용하고 싶다. 그것을 수정하는 방법을 모르겠습니다.

Dim ws As Workspace, db As Database, rs As Recordset 
Dim sqlstr As String, ToolID As String 

Private Sub OpenODBC(ws As Workspace, db As Database, dsn As String, id As String, pwd As String) 
    Dim dsnStr As String 
    Set ws = CreateWorkspace("ODBCWorkspace", "", "", dbUseODBC) 
    Workspaces.Append ws 
    ws.LoginTimeout = 300 
    dsnStr = "ODBC;DSN=" & dsn & ";UID=" & uid & ";PWD=" & pwd 
    Set db = ws.OpenConnection(dsn, dbDriverNoPrompt, False, dsnStr) 
    db.QueryTimeout = 1800 
End Sub 

Sub Tool() 

    On Error Goto errhandler: 

    Call OpenODBC(ws, db, "AC", "USERNAME", "PASSWORD") 

    sqlstr = "SELECT FHOPEHS.LOT_ID, FHOPEHS.TOOL_ID" & Chr(13) & "" & Chr(10) & "FROM DB2.FHOPEHS FHOPEHS" & Chr(13) & "" & Chr(10) & "WHERE (FHOPEHS.LOT_ID='NPCC1450.6H') AND (FHOPEHS.TOOL_ID Like 'WPTMZ%')" 

    Set rs = db.OpenRecordset(sqlstr, dbOpenSnapshot) 

    ToolID = rs("TOOL_ID") 

    Goto ending 

    errhandler: 
    If Err.Number = 1004 Then 
     Goto ending 
    End If 
    ending: 

    MsgBox ToolID 

End Sub 

나는이 인트라넷입니다 공유 할 수있는 외부 링크를 가지고 있지만, 아래에 내가 대신 워크 시트 셀의 배열에 결과를 저장하기 위해 수정하기 위해 노력하고있어 내 코드입니다하지 않습니다 - 아래와 같이 내 코드에서 대상은 워크 시트의 셀 "A1"입니다.

I 방법 직접 변수에 데이터를 저장하는 프로그램을 등록한 초기 예

" 설정 RS = db.OpenRecordset (sqlstr, dbOpenSnapshot)".

그물에서 찾은 다른 솔루션은 데이터를 워크 시트의 위치에 저장 한 다음 배열로 옮겨 워크 시트의 내용을 삭제하는 작업을 완료합니다. 이 프로 시저를 수행하는 데 관심이 없으며 쿼리 결과에서 변수로 직접 이동하고자합니다.

Sheets("Raw Data").Select 

Cells.Select 
Selection.ClearContents 
Selection.QueryTable.Delete 

With ActiveSheet.QueryTables.Add(Connection:= _ 
    "URL;http://myInternalAddress/myServerSideApp.php", Destination:=Range("A1")) 
    .Name = "AcctQry" 
    .FieldNames = True 
    .RowNumbers = False 
    .FillAdjacentFormulas = False 
    .PreserveFormatting = True 
    .RefreshOnFileOpen = False 
    .BackgroundQuery = True 
    .RefreshStyle = xlInsertDeleteCells 
    .SavePassword = True 
    .SaveData = True 
    .AdjustColumnWidth = True 
    .RefreshPeriod = 0 
    .WebSelectionType = xlEntirePage 
    .WebFormatting = xlWebFormattingNone 
    .WebPreFormattedTextToColumns = True 
    .WebConsecutiveDelimitersAsOne = True 
    .WebSingleBlockTextImport = False 
    .WebDisableDateRecognition = False 
    .WebDisableRedirections = False 
    .Refresh BackgroundQuery:=False 
End With 

는 예상되는 결과는 데이터를 스트리밍 PHP 코드는 다음이

function getEngineers() 
    { 
     $sql = 'select `engname` as `name`, `engineer` as `initials` from `engineers`'; 
     if ($result = $db->query($sql)) 
     { 
      if ($result->num_rows > 0) 
      { 
?> 
        <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> 
        <html lang="en"> 
         <head></head> 
         <body> 
          <table> 
           <tbody> 
<?php 
            while ($n = $result->fetch_array()) 
            { 
             echo '<tr><td>'.$n['name'].'</td><td>'.$n['initials'].'</td></tr>'; 
            } 
?> 
           </tbody> 
          </table> 

         </body> 
        </html> 
<?php 
      }else{ 
       throw new Exception('No names returned'); 
      } 
     }else{ 
      throw new Exception("Query to get engineer's names failed"); 
     } 
    } 

처럼 보이는 브라우저에서 출력 이름 및 이니셜

의 목록이 될 것입니다. 기본적으로 두 개의 열, 1. 이름, 2. 이니셜 여기

enter image description here

확인

는 HTML 코드의 스크린 샷, 독특한 아무 것도 여기에 Screen shot of html output

+0

IE를 자동화하고 DOM에서 필요한 데이터를 검색하거나 XHR을 만들고 응답을 구문 분석하도록하십시오.통찰력을 위해 추출해야하는 URL 및 데이터 설명을 공유하십시오. – omegastripes

+0

이 과정에서 IE를 사용하지 않습니다. 내 브라우저는 FireFox입니다. 그러나 내가 만들고 싶은 루틴에서는 브라우저가 호출되지 않습니다. 나는 그것을 서버로 보내는 Excel에서 쿼리를 생성합니다. 응답은 MySQL 데이터베이스에서 PHP로 웹 서버 측에서 반환되고 Apache Server를 통해 스트리밍됩니다. – Claus

+0

실제로 웹 쿼리는 Internet Explorer의 기능을 사용합니다. 그것이 요점의 옆에 있지만. 나는 당신이 원하는 것을 성취하기 위해 다른 데이터를 긁는 방법으로 전환하는 것을 의미합니다. 데이터를 변수에 직접 가져옵니다. 따라서 데이터베이스에서 데이터를 얻으려면 ADODB, ODBC ActiveX (위의 예와 같이), 웹 페이지 (IE 또는 XHR ActiveX)를 사용하십시오. FireFox에 사용할 수있는 ActiveX가 없습니다. – omegastripes

답변

1

을 보여주는 예입니다 방법 IE를 자동화하고 DOM에서 데이터를 검색하고 XHR을 만들고 응답을 구문 분석합니다. 다음과 같이 테스트를위한

샘플은 다음과 같습니다

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> 
<html lang="en"> 
    <head></head> 
    <body> 
     <table> 
      <tbody> 
       <tr><td>Miggs, Thomas </td><td>TJM</td></tr> 
       <tr><td>Nevis, Scott </td><td>SRN</td></tr> 
       <tr><td>Swartz, Jeff </td><td>JRS</td></tr> 
       <tr><td>Manner, Jack </td><td>JTM</td></tr> 
       <tr><td>Muskey, Timothy </td><td>TMM</td></tr> 
       <tr><td>Koeller, Steven </td><td>SRK</td></tr> 
       <tr><td>Masters, Jeff </td><td>JLM</td></tr> 
      </tbody> 
     </table> 
    </body> 
</html> 

내가 디버그 목적으로가 액세스 할 수 있도록 만들 link하여 배치.

코드 IE 자동화 및 DOM에서 필요한 데이터를 검색 :

Sub TestIE() 

    Dim aRes As Variant 
    Dim i As Long 

    With CreateObject("InternetExplorer.Application") 
     ' Make visible for debug 
     .Visible = True 
     ' Navigate to page 
     .Navigate "https://googledrive.com/host/0BwJV6wOaXFzIZkZDRzVmX2ptNm8" 
     ' Wait for IE ready 
     Do While .ReadyState <> 4 Or .Busy 
      DoEvents 
     Loop 
     ' Wait for document complete 
     Do While .Document.ReadyState <> "complete" 
      DoEvents 
     Loop 
     ' Wait for target table accessible 
     Do While .Document.getElementsByTagName("table").Length = 0 
      DoEvents 
     Loop 
     ' Process target table 
     With .Document.getElementsByTagName("table")(0) 
      ' Create 2d array 
      ReDim aRes(1 To .Rows.Length, 1 To 2) 
      ' Process each table row 
      For i = 1 To .Rows.Length 
       With .Rows(i - 1).Cells 
        ' Assign cells content to array elements 
        aRes(i, 1) = .Item(0).innerText 
        aRes(i, 2) = .Item(1).innerText 
       End With 
      Next 
     End With 
     .Quit 
    End With 

End Sub 

코드 XHR로 요청하고 정규식 응답 파싱 :

Sub TestXHR() 

    Dim sRespText As String 
    Dim aRes As Variant 
    Dim i As Long 

    With CreateObject("MSXML2.ServerXMLHttp") 
     .Open "GET", "https://f1aef461d18be47b73b6fa674791d9bc6ba6da82.googledrive.com/host/0BwJV6wOaXFzIZkZDRzVmX2ptNm8/", False 
     .Send 
     sRespText = .responseText 
    End With 

    With CreateObject("VBScript.RegExp") 
     .Global = True 
     .MultiLine = True 
     .IgnoreCase = True 
     .Pattern = "<tr><td>([\s\S]*?)</td><td>([\s\S]*?)</td></tr>" 
     ' Get matches collection 
     With .Execute(sRespText) 
      ' Create 2d array 
      ReDim aRes(1 To .Count, 1 To 2) 
      ' Process each match 
      For i = 1 To .Count 
       ' Assign submatches content to array elements 
       With .Item(i - 1) 
        aRes(i, 1) = .SubMatches(0) 
        aRes(i, 2) = .SubMatches(1) 
       End With 
      Next 
     End With 
    End With 

End Sub 

두 방법은 동일한 결과를 얻을 aRes 마지막 줄 바꿈 지점의 배열 :

result

+0

두 번째 옵션은 내가 찾고있는 옵션이었습니다. 나는 그들이 같은 일을하지만 더 전통적인 AJAX 구조를 사용하는 것이 나에게 익숙하다는 것을 이해한다. – Claus

+0

옵션 1 "에 대한 질문 CreateObject ("InternetExplorer.Application ")"InternetExplorer로 제한 되었습니까? 아니면 최신 브라우저 Edge를 호출 할 수 있습니까? Edge는 split()과 비슷한 document.querySelector 또는 document.querySelectorAll을 사용하여 DOM을 구문 분석 할 수있게 해주는 최신 명령 중 일부를 포함 할 수 있으며 문서 노드를 걸을 필요없이 RegEx – Claus

+0

@ 클로스, [가장자리 자동화에 관한] (http://stackoverflow.com/a/31306444/2165759). – omegastripes