我正在使用以下代码循环访问电子表格中的数据以创建 XML 文件:
Private Sub btn_Submit_Click()
Dim colIndex As Integer
Dim rwIndex As Integer
Dim asCols() As String
Dim oWorkSheet As Worksheet
Dim sName As String
Dim lCols As Long, lRows As Long
Dim iFileNum As Integer
Dim str_switch As String ' To use first column as node
Dim blnSwitch As Boolean
Dim rng As Range
For Each rng In ActiveSheet.UsedRange
If Application.WorksheetFunction.IsText(rng) Then
i = i + 1
End If
Next rng
Set oWorkSheet = ThisWorkbook.Worksheets("Sheet1")
sName = oWorkSheet.Name
lCols = i
iFileNum = FreeFile
Open "C:\temp\test2.xml" For Output As #iFileNum
Print #iFileNum, "<?xml version=""1.0""?>"
Print #iFileNum, "<" & sName & ">" ' add sheet name to xml file as First Node
i = 1
Do Until i = lCols + 1
Print #iFileNum, " <" & oWorkSheet.Cells(1, i).Text & ">" & Trim(oWorkSheet.Cells(2, i).Value) & "</" & oWorkSheet.Cells(1, i).Text & ">"
i = i + 1
Loop
Print #iFileNum, "</" & sName & ">"
Close #iFileNum
MsgBox ("Complete")
ErrorHandler:
If iFileNum > 0 Then Close #iFileNum
Exit Sub
End Sub
这个过程完美地创建了我想要的标签名称,并插入了输入的文本。问题出现在我需要使用以下一小段代码插入存储在其中一个单元格中的附件时:
Set rng = Range("AH2") 'Name the cell in which you want to place the attachment
rng.RowHeight = 56
On Error Resume Next
fpath = Application.GetOpenFilename("All Files,*.*", Title:="Select file", MultiSelect:=True)
For i = 1 To UBound(fpath)
rng.Select
rng.ColumnWidth = 12
ActiveSheet.OLEObjects.Add _
Filename:=fpath(i), _
Link:=False, _
DisplayAsIcon:=True, _
IconFileName:="excel.exe", _
IconIndex:=0, _
IconLabel:=extractFileName(fpath(i))
Set rng = rng.Offset(0, 1)
Next i
MsgBox ("Document Uploaded")
由于某种原因,该文档未出现在其相关标签中。有谁知道我哪里出错了,或者我是否在尝试不可能的事情!
最佳答案
您必须声明 OleObject
的变量类型:
Dim ol As OLEObject
然后,在 for next
循环中:
Set ol = ActiveSheet.OLEObjects.Add(....)
With ol
.Top = rng.Top
.Left = rng.Left
End With
关于excel - 使用 VBA 将附件插入 XML 标记,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/56763848/