使用 VBA 将附件插入到 XML 标记

Posted 2023-02-19

【中文标题】使用 VBA 将附件插入到 XML 标记

【英文标题】：insert an attachment to an XML tag using VBA

【发布时间】：2019-11-07 20:53:53

【问题描述】：

我正在使用以下代码循环浏览电子表格中的数据以创建 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")

由于某种原因，该文档没有出现在其相关标签中。有谁知道我哪里出错了，或者我是否正在尝试不可能的事情！

【问题讨论】：

is not appearing in its relevant tag - 究竟是什么意思？没有这个标签，或者它的内容不正确？

一个 OLE 对象附加到 Sheet 而不是 Range/Cell。使用ActiveSheet.OLEObjects 检索它。根据类型，可以使用obj.Object.Text 访问内容。如果不是，则duplicate the object and locate the temp file 或copy/parse 剪贴板。

您想在 XML 文件中添加什么？附件名称？它的内容？

其实一个XML文档是纯文本，所以你可以添加到它的是纯文本。这可能是文件的 URL 或路径，或文件的（纯文本）内容。您需要更精确地确定结果的外观。

【参考方案1】：

你必须声明OleObject的变量类型：

Dim ol As OLEObject

然后，在for next 循环内：

Set ol = ActiveSheet.OLEObjects.Add(....)
With ol
    .Top = rng.Top
    .Left = rng.Left
End With

更多详情请见：vba macro to embed OLEobject based on cell