1. ホーム
  2. 質問と答え
  3. ここでVBAマクロ

ここでVBAマクロ

2017-12-19 21 views
1

新しいユーザーとまれ/未経験コーダを使用して個別のXMLファイルに列見出しを繰り返したスプレッドシートの行に変換します。私はスプレッドシートの各行にXMLファイルを作成するVBAマクロのために、このサイトにしばらく前にsolutionを見つけました。私はアーカイブで作業しており、デジタルリポジトリシステムでは、記述するファイルと同じファイル名（メタデータ拡張機能が追加されている）を持つXMLメタデータファイルが必要です。これは、システムがそれを離散ファイルではなくメタデータとして認識するためです。これを実現するために、メタデータをスプレッドシートに記録し、メタデータのスキーマ要素と一致する列見出しを付け、VBAマクロを実行してデータの各行に対してXMLファイルを作成します。ここでVBAマクロ

マクロは、実際には、スプレッドシートの各列から個々のXMLファイルを作成するために完璧に動作します。この問題は、繰り返し要素をサポートするためにメタデータスキーマを更新した後に発生しました。繰り返される列見出し/要素を含むスプレッドシートでVBAマクロを実行すると、結果のXMLファイルには繰り返し要素の最後のインスタンスのデータしか含まれません。最後の繰り返し要素からのこの同じデータ値は、前のインスタンスにも適用されます。

ここに私が話していることがあります。あなたが見ることができるように、XMLファイル内で繰り返される「RecordContributorIndividual」の要素は、スプレッドシートの要素（行1、列7）の最後のインスタンスからのデータのみを持っている：

<?xml version="1.0" encoding="UTF-8"?> 
    <vtcore xmlns="http://www.sec.state.vt.us/vtcore"> 
    <RecordCreatorIndividual>Peter Shumlin</RecordCreatorIndividual> 
    <RecordContributorIndividual>Stuck</RecordContributorIndividual> 
    <RecordContributorIndividual>Stuck</RecordContributorIndividual> 
    <RecordContributorIndividual>Stuck</RecordContributorIndividual> 
    <RecordContributorIndividual>Stuck</RecordContributorIndividual> 
    <RecordContributorIndividual>Stuck</RecordContributorIndividual> 
    <RecordTitle>President Ronald Reagan Day proclamation</RecordTitle> 
    <RecordDesc></RecordDesc>

Spreadsheet Repeated Elements

何達成したいのは、繰り返し要素の最後のセル値をその要素の以前のすべてのインスタンスに適用しないで、代わりに各要素の下のスプレッドシートセルに実際に何かを引っ張るVBAコードです。 以下のVBAコードを貼り付けました。私は問題が "doc.getElementsByTagName"地域のどこかにあると感じていますが、私は肯定的ではありません。私は近くにいるように感じるが、私は完全に立ち往生している。どんな助けでも大歓迎です！

Sub testXLSMtovtcoreXML() 
sTemplateXML = _ 
    "<?xml version='1.0' encoding='UTF-8'?>" + vbNewLine + _ 
    "<vtcore xmlns='http://www.sec.state.vt.us/vtcore'>" + vbNewLine + _ 
    " <RecordCreatorIndividual>" + " </RecordCreatorIndividual>" + " 
    <RecordContributorIndividual>" + " </RecordContributorIndividual>" + 
    vbNewLine + _ 
    " <RecordContributorIndividual>" + " </RecordContributorIndividual>" 
    + " <RecordContributorIndividual>" + " 
    </RecordContributorIndividual>" + vbNewLine + _ 
    " <RecordContributorIndividual>" + " </RecordContributorIndividual>" 
    + " <RecordContributorIndividual>" + " 
    </RecordContributorIndividual>" + vbNewLine + _ 
    " <RecordTitle>" + " </RecordTitle>" + " <RecordDesc>" + " 
    </RecordDesc>" + " <RecordDate>" + " </RecordDate>" + " 
    <RecordDate>" + " </RecordDate>" + vbNewLine + _ 
    " <RecordDate>" + " </RecordDate>" + " <RecordDate>" + " 
    </RecordDate>" + " <RecordDate>" + " </RecordDate>" + vbNewLine + _ 
    " <Agency>" + " </Agency>" + " <Domain>" + " </Domain>" + " 
    <Activity>" + " </Activity>" + " <RecordType>" + " </RecordType>" 
    + vbNewLine + _ 
    " <ClassificationCode>" + " </ClassificationCode>" + " 
    <RelatedRecords>" + " </RelatedRecords>" + " <RelatedRecords>" + " 
    </RelatedRecords>" + vbNewLine + _ 
    " <RelatedRecords>" + " </RelatedRecords>" + " <RelatedRecords>" + 
    " </RelatedRecords>" + " <RelatedRecords>" + " </RelatedRecords>" 
    + vbNewLine + _ 
    " <RecordIdentifier>" + " </RecordIdentifier>" + " <PublicAccess>" 
    + " </PublicAccess>" + " <PublicAccessCitation>" + " 
    </PublicAccessCitation>" + vbNewLine + _ 
    " <PublicAccessCitation>" + " </PublicAccessCitation>" + " 
    <PublicAccessCitation>" + " </PublicAccessCitation>" + vbNewLine + _ 
    " <PublicAccessCitation>" + " </PublicAccessCitation>" + " 
    <PublicAccessCitation>" + " </PublicAccessCitation>" + vbNewLine + _ 
    " <Subject>" + " </Subject>" + " <Subject>" + " </Subject>" + " 
    <Subject>" + " </Subject>" + " <Subject>" + " </Subject>" + 
    vbNewLine + _ 
    " <Subject>" + " </Subject>" + vbNewLine + _ 
    "</vtcore>" + vbNewLine 

Set doc = CreateObject("MSXML2.DOMDocument") 
doc.async = False 
doc.validateOnParse = False 
doc.resolveExternals = False 

With ActiveWorkbook.Worksheets(1) 
lLastRow = .UsedRange.Rows.Count 

For lRow = 2 To lLastRow 
    sFileName = .Cells(lRow, 1).Value 
    sRecordCreatorIndividual = .Cells(lRow, 2).Value 
    sRecordContributorIndividual = .Cells(lRow, 3).Value 
    sRecordContributorIndividual = .Cells(lRow, 4).Value 
    sRecordContributorIndividual = .Cells(lRow, 5).Value 
    sRecordContributorIndividual = .Cells(lRow, 6).Value 
    sRecordContributorIndividual = .Cells(lRow, 7).Value 
    sRecordTitle = .Cells(lRow, 8).Value 
    sRecordDesc = .Cells(lRow, 9).Value 
    sRecordDate = .Cells(lRow, 10).Value 
    sRecordDate = .Cells(lRow, 11).Value 
    sRecordDate = .Cells(lRow, 12).Value 
    sRecordDate = .Cells(lRow, 13).Value 
    sRecordDate = .Cells(lRow, 14).Value 
    sAgency = .Cells(lRow, 15).Value 
    sDomain = .Cells(lRow, 16).Value 
    sActivity = .Cells(lRow, 17).Value 
    sRecordType = .Cells(lRow, 18).Value 
    sClassificationCode = .Cells(lRow, 19).Value 
    sRelatedRecords = .Cells(lRow, 20).Value 
    sRelatedRecords = .Cells(lRow, 21).Value 
    sRelatedRecords = .Cells(lRow, 22).Value 
    sRelatedRecords = .Cells(lRow, 23).Value 
    sRelatedRecords = .Cells(lRow, 24).Value 
    sRecordIdentifier = .Cells(lRow, 25).Value 
    sPublicAccess = .Cells(lRow, 26).Value 
    sPublicAccessCitation = .Cells(lRow, 27).Value 
    sPublicAccessCitation = .Cells(lRow, 28).Value 
    sPublicAccessCitation = .Cells(lRow, 29).Value 
    sPublicAccessCitation = .Cells(lRow, 30).Value 
    sPublicAccessCitation = .Cells(lRow, 31).Value 
    sSubject = .Cells(lRow, 32).Value 
    sSubject = .Cells(lRow, 33).Value 
    sSubject = .Cells(lRow, 34).Value 
    sSubject = .Cells(lRow, 35).Value 
    sSubject = .Cells(lRow, 36).Value 

doc.LoadXML sTemplateXML 
doc.getElementsByTagName("RecordCreatorIndividual")(0).appendChild 
doc.createTextNode(sRecordCreatorIndividual) 
doc.getElementsByTagName("RecordContributorIndividual")(0).appendChild 
doc.createTextNode(sRecordContributorIndividual) 
doc.getElementsByTagName("RecordContributorIndividual")(1).appendChild 
doc.createTextNode(sRecordContributorIndividual) 
doc.getElementsByTagName("RecordContributorIndividual")(2).appendChild 
doc.createTextNode(sRecordContributorIndividual) 
doc.getElementsByTagName("RecordContributorIndividual")(3).appendChild 
doc.createTextNode(sRecordContributorIndividual) 
doc.getElementsByTagName("RecordContributorIndividual")(4).appendChild 
doc.createTextNode(sRecordContributorIndividual) 
doc.getElementsByTagName("RecordTitle")(0).appendChild 
doc.createTextNode(sRecordTitle) 
doc.getElementsByTagName("RecordDesc")(0).appendChild 
doc.createTextNode(sRecordDesc) 
doc.getElementsByTagName("RecordDate")(0).appendChild 
doc.createTextNode(sRecordDate) 
doc.getElementsByTagName("RecordDate")(1).appendChild 
doc.createTextNode(sRecordDate) 
doc.getElementsByTagName("RecordDate")(2).appendChild 
doc.createTextNode(sRecordDate) 
doc.getElementsByTagName("RecordDate")(3).appendChild 
doc.createTextNode(sRecordDate) 
doc.getElementsByTagName("RecordDate")(4).appendChild 
doc.createTextNode(sRecordDate) 
doc.getElementsByTagName("Agency")(0).appendChild 
doc.createTextNode(sAgency) 
doc.getElementsByTagName("Domain")(0).appendChild 
doc.createTextNode(sDomain) 
doc.getElementsByTagName("Activity")(0).appendChild 
doc.createTextNode(sActivity) 
doc.getElementsByTagName("RecordType")(0).appendChild 
doc.createTextNode(sRecordType) 
doc.getElementsByTagName("ClassificationCode")(0).appendChild 
doc.createTextNode(sClassificationCode) 
doc.getElementsByTagName("RelatedRecords")(0).appendChild 
doc.createTextNode(sRelatedRecords) 
doc.getElementsByTagName("RelatedRecords")(1).appendChild 
doc.createTextNode(sRelatedRecords) 
doc.getElementsByTagName("RelatedRecords")(2).appendChild 
doc.createTextNode(sRelatedRecords) 
doc.getElementsByTagName("RelatedRecords")(3).appendChild 
doc.createTextNode(sRelatedRecords) 
doc.getElementsByTagName("RelatedRecords")(4).appendChild 
doc.createTextNode(sRelatedRecords) 
doc.getElementsByTagName("RecordIdentifier")(0).appendChild 
doc.createTextNode(sRecordIdentifier) 
doc.getElementsByTagName("PublicAccess")(0).appendChild 
doc.createTextNode(sPublicAccess) 
doc.getElementsByTagName("PublicAccessCitation")(0).appendChild 
doc.createTextNode(sPublicAccessCitation) 
doc.getElementsByTagName("PublicAccessCitation")(1).appendChild 
doc.createTextNode(sPublicAccessCitation) 
doc.getElementsByTagName("PublicAccessCitation")(2).appendChild 
doc.createTextNode(sPublicAccessCitation) 
doc.getElementsByTagName("PublicAccessCitation")(3).appendChild 
doc.createTextNode(sPublicAccessCitation) 
doc.getElementsByTagName("PublicAccessCitation")(4).appendChild 
doc.createTextNode(sPublicAccessCitation) 
doc.getElementsByTagName("Subject")(0).appendChild 
doc.createTextNode(sSubject) 
doc.getElementsByTagName("Subject")(1).appendChild 
doc.createTextNode(sSubject) 
doc.getElementsByTagName("Subject")(2).appendChild 
doc.createTextNode(sSubject) 
doc.getElementsByTagName("Subject")(3).appendChild 
doc.createTextNode(sSubject) 
doc.getElementsByTagName("Subject")(4).appendChild 
doc.createTextNode(sSubject) 
doc.Save sFileName + ".metadata" 
Next 

End With 
End Sub

出典

2017-12-19 zwhitaker

+1

質問内のテキスト情報を提供していないテキストの絵などの外部リンクとしてではなくてください。 – Yunnosch

+0

@Yunnosch私はこのサイトで私の経験不足をお詫び申し上げます。スクリーンショットへのリンクの代わりにXMLを表示するための最初のリンクを編集しました。明らかに私はまだインラインのスクリーンショットは許可されていません。 2番目のリンクはスプレッドシートのスクリーンショットへのリンクであり、そのデータをテキストとして表示する別の方法を考えることはできず、それでもわかりやすいものです。この質問を可能な限り明確にしたいと思っているので、私はそれに代わる提案をしています。再び、私の謝罪。 – zwhitaker

答えて

0

は、ハードコードのノード名またはテキスト値をしませんが、細胞からそれらを引っ張るそのcreateElement、createNode、appendChild方法でMSXMLライブラリを使用して動的にXMLを構築することを検討してください。そして、Identity Transform XSLTを使用して出力をきれいに印刷します。コードで調整するテキストテンプレートを作成する必要はありません。

エクセル入力データ

Screenshot of Data

VBA（MSXML参照オブジェクトで事前バインディングを使用）

：ドキュメント xmlns="http://www.sec.state.vt.us/vtcore"のデフォルトの名前空間を必要とするので、具体的には、 createNodeが使用されています 
Option Explicit 

Sub XMLExport() 
On Error GoTo ErrHandle 
    Dim lastCol As Long, lastRow As Long 
    Dim xlrow As Long 

    ' WRITE TO XML 
    With ThisWorkbook.Sheets(1) 
     lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column 
     lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 

     For xlrow = 2 To lastRow 
      Call BuildXML(xlrow) 
     Next xlrow 
    End With 

    MsgBox "Successfully migrated Excel data into XML files!", vbInformation 

ExitHandle: 
    Exit Sub 

ErrHandle: 
    MsgBox Err.Number & " - " & Err.Description, vbCritical 
    Resume ExitHandle 

End Sub 

Function BuildXML(i As Long) 
On Error GoTo ErrHandle 
    ' REFERENCE Microsoft XML, v6.0 UNDER TOOLS\REFERENCES 
    Dim doc As New MSXML2.DOMDocument, xslDoc As New MSXML2.DOMDocument, newDoc As New MSXML2.DOMDocument 
    Dim root As IXMLDOMNode, colNode As IXMLDOMNode 

    Dim xslFile As String, xml_filename As String 
    Dim lastCol As Long, lastRow As Long 
    Dim j As Long 

    ' DECLARE XML DOC OBJECT 
    Set root = doc.createNode(1, "vtcore", "http://www.sec.state.vt.us/vtcore") 
    doc.appendChild root 

    ' WRITE TO XML 
    With ThisWorkbook.Sheets(1) 
     lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column 
     lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 

     xml_filename = Mid(.Cells(i, 1), 1, InStr(.Cells(i, 1), ".") - 1) & ".metadata" 

     For j = 2 To lastCol 

      Set colNode = doc.createNode(1, .Cells(1, j), "http://www.sec.state.vt.us/vtcore") 
      colNode.Text = .Cells(i, j) 
      root.appendChild colNode 

     Next j 
    End With 

    ' PRETTY PRINT OUTPUT WITH INDENTATION AND LINE BREAKS 
    xslDoc.LoadXML "<?xml version=" & Chr(34) & "1.0" & Chr(34) & "?>" _ 
      & "<xsl:stylesheet version=" & Chr(34) & "1.0" & Chr(34) _ 
      & "    xmlns:xsl=" & Chr(34) & "http://www.w3.org/1999/XSL/Transform" & Chr(34) & ">" _ 
      & " <xsl:strip-space elements=" & Chr(34) & "*" & Chr(34) & " />" _ 
      & " <xsl:output method=" & Chr(34) & "xml" & Chr(34) & " indent=" & Chr(34) & "yes" & Chr(34) & "" _ 
      & "   encoding=" & Chr(34) & "UTF-8" & Chr(34) & "/>" _ 
      & " <xsl:template match=" & Chr(34) & "node() | @*" & Chr(34) & ">" _ 
      & " <xsl:copy>" _ 
      & "  <xsl:apply-templates select=" & Chr(34) & "node() | @*" & Chr(34) & " />" _ 
      & " </xsl:copy>" _ 
      & " </xsl:template>" _ 
      & "</xsl:stylesheet>" 

    xslDoc.async = False 
    doc.transformNodeToObject xslDoc, newDoc 
    newDoc.Save Application.ActiveWorkbook.Path & "\" & xml_filename 
    Debug.Print xml_filename 

ExitHandle: 
    Set doc = Nothing: Set xslDoc = Nothing: Set newDoc = Nothing 
    Exit Function 

ErrHandle: 
    MsgBox Err.Number & " - " & Err.Description, vbCritical 
    Resume ExitHandle 

End Function

出力

<?xml version="1.0" encoding="UTF-8"?> 
<vtcore xmlns="http://www.sec.state.vt.us/vtcore"> 
    <FileName>16-001 President Ronald Reagan Day.pdf</FileName> 
    <RecordCreatorIndividual>Peter Shumulin</RecordCreatorIndividual> 
    <RecordCreatorIndividual>Help </RecordCreatorIndividual> 
    <RecordCreatorIndividual>I </RecordCreatorIndividual> 
    <RecordCreatorIndividual>Am</RecordCreatorIndividual> 
    <RecordCreatorIndividual>Realy</RecordCreatorIndividual> 
    <RecordCreatorIndividual>Stuck</RecordCreatorIndividual> 
    <RecordCreatorIndividual>President Ronald Reagan Day proclamation</RecordCreatorIndividual> 
</vtcore>

出典

2017-12-19 21:52:12 Parfait

+0

私の問題にお答えいただき、ありがとうございます。私はあなたのソリューションを実行しようとすると、 "コンパイルエラー：ユーザー定義型が特定されていません"、 "doc As New MSXML2.DOMDocument"ステートメントが強調表示されます。 Microsoft XML v6.0がTools/Referencesに追加されていることを確認しました。私はこの情報が関連しているかどうかは分かりませんが、 "http://www.sec.state.vt.us/vtcore"は実際に存在するアドレスではありません。それはちょうどそこにハードコードされているので、参照としては機能しないかもしれません。 – zwhitaker

+0

コードに直接コメントされているように、VBEエディタのTools \ References（メニュー上）のMicrosoft XML、v6.0を選択しましたか？ – Parfait

+0

私はそれをしました、そして、それは同じ場所で同じエラーでまだ戻ってきます。今、私が選択した参照は次のとおりです。Visual Basic for Applications; Microsoft Excel 15.0オブジェクトライブラリ。 OLEオートメーション; Microsoft Office 15.0オブジェクトライブラリ。 Microsoft XML、v6.0。 – zwhitaker

関連する問題

 関連する問題