web-dev-qa-db-ja.com

VBAを介してXMLをExcelにロードする

VBAを介してXMLファイルをロードするVBAが少しあります。ただし、インポートされると、すべて1列になり、テーブルに分割されません。

これを[データ]タブから手動でインポートすると、スキーマがないという警告が表示されますが、Excelでソースデータに基づいてスキーマを作成するかどうかを尋ねられます。これにより、すべてのデータがニーステーブルに配置されます。

これを私の現在のVBAコード内で自動的に発生させたい：

VBAは次のようになります

      Sub refresh()

'--------------------------------1. Profile IDs-----------------------------------'


'date variables

Dim start_period As String
start_period = Sheets("Automated").Cells(1, 6).Value
Dim end_period As String
end_period = Sheets("Automated").Cells(1, 7).Value

'report id variable names
Dim BusinessplanningReportID As String

'--------------------------------REST queries--------------------------------'
Dim Businessplanning As String



'REST query values
Businessplanning = "URL;http://api.trucast.net/2/saved_searches/00000/pivot/content_volume_trend/?apikey=0000000&start=" + start_period + "&end=" + end_period + "&format=xml"




'--------------------------------------------Data connections-----------------------------------'
'key metrics
With Worksheets("Sheet1").QueryTables.Add(Connection:=Businessplanning, Destination:=Worksheets("Sheet1").Range("A1"))

  .RefreshStyle = xlOverwriteCells
  .SaveData = True

End With

現在、データは構造化されていないこのように表示されます。これを自動的にテーブルにするにはどうすればよいですか？

<result>
<entry>
<published_date>20130201</published_date>
<post_count>18</post_count>
</entry>

おかげで、

：：最終的解決：：

 Sub XMLfromPPTExample2()
Dim XDoc As MSXML2.DOMDocument
Dim xresult As MSXML2.IXMLDOMNode
Dim xentry As MSXML2.IXMLDOMNode
Dim xChild As MSXML2.IXMLDOMNode
Dim start_period As String
    start_period = Sheets("Automated").Cells(1, 6).Value
    Dim end_period As String
    end_period = Sheets("Automated").Cells(1, 7).Value
Dim wb As Workbook
Dim Col As Integer
Dim Row As Integer


Set XDoc = New MSXML2.DOMDocument
XDoc.async = False
XDoc.validateOnParse = False
XDoc.Load ("http://api.trucast.net/2/saved_searches/0000/pivot/content_volume_trend/?apikey=00000&start=" + start_period + "&end=" + end_period + "&format=xml")
LoadOption = xlXmlLoadImportToList

Set xresult = XDoc.DocumentElement
Set xentry = xresult.FirstChild


Col = 1
Row = 1

For Each xentry In xresult.ChildNodes
 Row = 1


    For Each xChild In xentry.ChildNodes
      Worksheets("Sheet2").Cells(Col, Row).Value = xChild.Text
             'MsgBox xChild.BaseName & " " & xChild.Text
      Row = Row + 1
      'Col = Col + 1

          Next xChild
'Row = Row + 1
Col = Col + 1
Next xentry

End Sub
xmlexcelapivbaschema
9
Fox87

「ハードコード」方法IS THIS：

これから

<result>
   <entry>
      <published_date>20130201</published_date>
      <post_count>18</post_count>    
   </entry>
  <entry>
      <published_date>20120201</published_date>
      <post_count>15</post_count>    
   </entry>

2つの列を持つExcelを取得したい場合：

**published_date** |  **post_count**
20130201       |           18
20120201       |           15

あなたのXMLでは常に

<result><entry><Element>VALUE</Element><Element...n>VALUE</Element...n></entry>

重要：PowerPoint、Excel、WordでVBAエディターを開き、 "Microsoft XML、v3.0"への参照を追加します（この参照はOffice 2000用です...他にもある可能性があります）。

ソース： http://vba2vsto.blogspot.it/2008/12/reading-xml-from-vba.html

Employee.XML

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<EmpDetails>
<Employee>
<Name>ABC</Name>
<Dept>IT-Software</Dept>
<Location>New Delhi</Location>
</Employee>
<Employee>
<Name>XYZ</Name>
<Dept>IT-Software</Dept>
<Location>Chennai</Location>
</Employee>
<Employee>
<Name>IJK</Name>
<Dept>HR Operations</Dept>
<Location>Bangalore</Location>
</Employee>
</EmpDetails>

XMLの上で読み取るコード

Sub XMLfromPPTExample()
Dim XDoc As MSXML2.DOMDocument
Dim xEmpDetails As MSXML2.IXMLDOMNode
Dim xEmployee As MSXML2.IXMLDOMNode
Dim xChild As MSXML2.IXMLDOMNode

Set XDoc = New MSXML2.DOMDocument
XDoc.async = False
XDoc.validateOnParse = False
XDoc.Load ("C:\Emp.xml")
Set xEmpDetails = XDoc.documentElement
Set xEmployee = xEmpDetails.firstChild
For Each xEmployee In xEmpDetails.childNodes
For Each xChild In xEmployee.childNodes
MsgBox xChild.baseName & " " & xChild.Text
Next xChild
Next xEmployee
End Sub

あなたの場合、もちろん、あなたはあなたのルーチンを適応させる必要があります：

結果->提供されたコードのEmpDetails
entry->提供されたコードの従業員

プラスその他の必要な調整。

このようにして、「entry」要素と「entry child」要素をいくつでも持つことができます。

実際、「エントリ」内のすべての要素をループすると、COLUMNが取得され、新しいエントリはすべて新しいROWになります。

残念ながら、私はMACにExcelを持っていないので、ロジックを配置します。独自の構文を確認する必要があります...このようにして、必要なワークシートにExcelテーブルを作成します。

Dim col = 1; Dim row=1;

For Each xEmployee In xEmpDetails.childNodes
    col = 1
    For Each xChild In xEmployee.childNodes
       Worksheets("NAMEOFTHESHEET").Cells(col, row).Value = xChild.Text
       MsgBox xChild.baseName & " " & xChild.Text
       col = col + 1;
    Next xChild
row = row+1;
Next xEmployee

正しい方法はこれである必要があります：

LoadOption：= xlXmlLoadImportToList？

URL呼び出しからXMLを取得していますが、最初にディスク上のXMLファイルを操作して、それが正しく有効かどうかを確認することを強くお勧めします。したがって、この "WebService"からサンプルXMLを取得して、ディスクに保存する必要があります。次の方法でロードしてみてください：

   Sub ImportXMLtoList()
    Dim strTargetFile As String
    Dim wb as Workbook

         Application.Screenupdating = False
         Application.DisplayAlerts = False
         strTargetFile = "C:\example.xml"
         Set wb = Workbooks.OpenXML(Filename:=strTargetFile,        LoadOption:=xlXmlLoadImportToList)
         Application.DisplayAlerts = True

         wb.Sheets(1).UsedRange.Copy ThisWorkbook.Sheets("Sheet2").Range("A1")
         wb.Close False
         Application.Screenupdating = True
    End Sub
9
Madthew

見つけたコードの他のセクションからいくつかのセクションを使用しました。以下のコードは、ユーザーに必要なXMLファイルを選択するように求め、新しいファイルを開かずに、選択したファイルを既存のマッピングに追加/インポートするだけです。

Sub Import_XML()
'
' Import_XML Macro
'
    'Select the file
    Fname = Application.GetOpenFilename(FileFilter:="xml files (*.xml), *.xml", MultiSelect:=False)

    'Check if file selected
    If Fname = False Then
        Exit Sub
        Else

    End If

    'Import selected XML file into existing, custom mapping

    Range("B5").Select
    ActiveWorkbook.XmlMaps("Result_file_Map").Import URL:=Fname
End Sub
0
Joe