创建循环以在Excel VBA中的记事本中填充XML文件



我正在尝试使循环工作以在记事本中生成XML文件。创建XML文件以及标题和页脚都可以。我遇到的问题是使脚本变得灵活。该脚本将定期运行,输入数据行的数量变化。我当前拥有的脚本确实为正确数量的用户生成了工作的XML文件,但是从第一个输入行重复了填充的数据。我已经对此进行了大脑,并在此处和其他网站上进行了搜索,但是我还没有发现任何能够应用的东西。我通常只使用VBA生成.xlsx文件,因此在记事本中工作有点超出了我的舒适区域。我尝试使用" Dim I作为整数",但范围(" d10"& i)。值等。任何帮助都将不胜感激。请参阅下面的脚本:

代码

Sub Macro1()
    ' Macro1 Macro
    unique = Range("C1").Value
    creation = Range("C2").Value
    Users = Range("C10:C1010").Cells.SpecialCells(xlCellTypeConstants).Count
    Total = Range("c4").Value
    batch = Range("C3").Value
    valuedate = Range("C6").Value
    myfilename = batch
    masterfile = "C:tempTEXTFILE.XML"
    'LastRow = Range("C10", Range("C10").End(xlDown)).Rows.Count
    Dim src As String, dst As String, fl As String
    Dim rfl As String
    FileNum = FreeFile ' next free filenumber
    'Open "C:TempTEXTFILE.TXT" For Output As #FileNum ' creates the new file
    Open "C:tempTEXTFILE.XML" For Output As #1
    'Header Script (no issue)
    ' Set numrows = number of rows of data.
    NumRows = Range("C10", Range("C10").End(xlDown)).Rows.Count
    '      ' Select cell C10.
    Range("C10").Select
    '      ' Establish "For" loop to loop "numrows" number of times.
    For x = 1 To NumRows
        '         ' Insert your code here.
        ' generate line specific data
        Print #FileNum, "         " & "<CdtTrfTxInf>" & vbNewLine &
        "            " & "<XXXXX>" & vbNewLine &
        "               " & "<XXXXXXX>"; Format(Month(valuedate), "00") &  Format(Day(valuedate), "00") & "-01<XXXXXXXX>" & vbNewLine & _
        "            " & "<XXXXXX>" & vbNewLine & _
        "            " & "<XXXXXX>" & vbNewLine & _
        "               " & "<XXXXXXXX" & """XXXXX""" & ">" & Range("D10").Value & 
        "<XXXXXX>" & vbNewLine & _
        "            " & "<XXXXX>" & vbNewLine & _
        "            " & "<XXXXXX>" & vbNewLine & _
        "               " & "<XXXXXXXXX>" & vbNewLine & _
        "                  " & "<XXXXXX>" & Range("H10").Value & "<XXXXXXX>" & vbNewLine & _
        "               " & "<XXXXXXXX>" & vbNewLine & _
        "            " & "<XXXXXXX>" & vbNewLine & _
        "            " & "<XXXXXXXXX>" & vbNewLine & _
        "               " & "<XXXXXX>" & Range("C10").Value & "<XXXXXXXX>" & vbNewLine & _
        "            " & "<XXXXXXX>" & vbNewLine & _
        "            " & "<XXXXXXXXX>" & vbNewLine & _
        "               " & "<XXXXXXXX>" & vbNewLine & _
        "                  " & "<XXXXXXXX>" & Range("G10").Value & "<XXXXXXX>" & vbNewLine & _
        "               " & "<XXXXXXX>" & vbNewLine & _
        "            " & "<XXXXXXXX>" & vbNewLine & _
        "            " & "<XXXXXXXXX>/XXXXXXXXXX/R/<XXXXXXXXXXXXX>" & vbNewLine & _
        "            " & "<XXXXXXXX>" & vbNewLine & _
        "               " & "<XXXXXXXX>" & Range("E10").Value & "<XXXXXX>" & vbNewLine & _
        "            " & "<XXXXXXXX>" & vbNewLine & _
        "         " & "<XXXXXXXXXXXXX>"
    Next
End Sub

一些提示:

  • 始终使用Option Explicit并声明您的变量。您可以使用Type来构建所需的相关信息。

  • 尝试使用对范围,工作簿或工作簿的完全合格的参考。

  • 避免通过单个值循环循环 - 数组更快。

我使用助手功能获取列号,以便如果要获得数组值,例如从" H"列(= 8):

v(x,s2col(" h"))

当然,您也可以使用v(x, 8)

您的模块的声明头

Option Explicit
Type TValues
     unique As Variant
     creation As Variant
     Users As Long
     Total As Variant
     batch As Variant
     valuedate As Variant
End Type
Dim MyValues As TValues

主过程

Sub Macro1()
' Purpose: create xml from sheet information using a 1-based 2-dim datafield array
Dim src As String, dst As String, fl As String
Dim rfl As String
Dim v                   ' variant (to receive one based 2dim data field array)
Dim oWs  As Worksheet   ' worksheet
Dim myfilename As String
Dim masterfile As String
Dim s          As String
Dim FileNum    As Long
Dim numRows    As Long
Dim x          As Long
Set oWs = ThisWorkbook.Worksheets("MySheet")
With MyValues
  .unique = oWs.Range("C1").value
  .creation = oWs.Range("C2").value
  .Users = oWs.Range("C10:C1010").Cells.SpecialCells(xlCellTypeConstants).Count
  .Total = oWs.Range("c4").value
  .batch = oWs.Range("C3").value
  .valuedate = oWs.Range("C6").value
  myfilename = .batch
  masterfile = "C:tempTEXTFILE.XML"
'LastRow = Range("C10", Range("C10").End(xlDown)).Rows.Count
FileNum = FreeFile ' next free filenumber
'Open "C:TempTEXTFILE.TXT" For Output As #FileNum ' creates the new file
 Open "D:tempTEXTFILE.XML" For Output As #1
'Header Script (no issue)
' ...
' Set numrows = number of rows of data.
  numRows = Range("C10", oWs.Range("C10").End(xlDown)).Rows.Count
' create a one based 2-dim datafield array
  v = oWs.Range("A10:H" & numRows + 9).value      ' plus 9 rows for information header
' loop throug array
For x = 1 To numRows
    '
    s = "         " & "<CdtTrfTxInf>" & vbNewLine & "            " & "<XXXXX>" & vbNewLine & _
    "               " & "<XXXXXXX>" & Format(Month(.valuedate), "00") & Format(Day(.valuedate), "00") & "-01<XXXXXXXX>" & vbNewLine & _
    "            " & "<XXXXXX>" & vbNewLine & "            " & "<XXXXXX>" & vbNewLine & _
    "               " & "<XXXXXXXX" & """XXXXX""" & ">" & v(x, s2Col("D")) & "<XXXXXX>" & vbNewLine & _
    "            " & "<XXXXX>" & vbNewLine & _
    "            " & "<XXXXXX>" & vbNewLine & _
    "               " & "<XXXXXXXXX>" & vbNewLine & _
    "                  " & "<XXXXXX>" & v(x, s2Col("H")) & "<XXXXXXX>" & vbNewLine & _
    "               " & "<XXXXXXXX>" & vbNewLine & _
    "            " & "<XXXXXXX>" & vbNewLine & _
    "            " & "<XXXXXXXXX>" & vbNewLine & _
    "               " & "<XXXXXX>" & v(x, s2Col("C")) & "<XXXXXXXX>" & vbNewLine & _
    "            " & "<XXXXXXX>" & vbNewLine & _
    "            " & "<XXXXXXXXX>" & vbNewLine & _
    "               " & "<XXXXXXXX>" & vbNewLine & _
    "                  " & "<XXXXXXXX>" & v(x, s2Col("G")) & "<XXXXXXX>" & vbNewLine & _
    "               " & "<XXXXXXX>" & vbNewLine & _
    "            " & "<XXXXXXXX>" & vbNewLine & _
    "            " & "<XXXXXXXXX>/XXXXXXXXXX/R/<XXXXXXXXXXXXX>" & vbNewLine & _
    "            " & "<XXXXXXXX>" & vbNewLine & _
    "               " & "<XXXXXXXX>" & v(x, s2Col("E")) & "<XXXXXX>" & vbNewLine & _
    "            " & "<XXXXXXXX>" & vbNewLine & _
    "         " & "<XXXXXXXXXXXXX>"
    Print #FileNum, s
Next
End With    ' Type MyValues
' don't forget to add a closing tag to receive a well formed XML file, e.g. ...
' Print #FileNum, "</root>"
'
' close text file
Close #FileNum
End Sub

辅助功能(参见提示上方)

从给定的列字母中获取列号:

Public Function s2Col(ByVal sCol As String) As Long
' Purpose: return column number, e.g. "H" -> 8
  s2Col = Range(sCol & ":" & sCol).Column
End Function

注意

当然,还有其他方法来创建XML文件(例如,通过XMLDOM方法引用MSXML2.Domdocument60对象)。

最新更新