我正在尝试使循环工作以在记事本中生成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对象)。