I am using the below code to cycle through data in a spreadsheet to create an XML file:
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
This process is working perfectly to create the tag names I want, and inserting the text entered. The problem arises where I need to insert an attachment which is stored in one of the cells using the following little chunk of code:
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")
For some reason, the document is not appearing in its relevant tag. Does anyone know where I am going wrong, or if I am attempting the impossible!