S
SauQ
Hi everyone,
I am still a learner in excel / vba. I am using XP pro and Microsoft
office 2003.
I have copied this UDF code (Private Function ExportToXML_C) that
exports my current data in an excel spreadsheet into an XML format.
Private Function ExportToXML_C(FullPath As String, RowName _
As String) As Boolean
On Error GoTo ErrorHandler
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
Set oWorkSheet = ActiveWorkbook.Worksheets("BorangC2007")
sName = oWorkSheet.Name
lCols = oWorkSheet.Columns.Count
lRows = oWorkSheet.Rows.Count
ReDim asCols(lCols) As String
iFileNum = FreeFile
Open FullPath For Output As #iFileNum
For i = 0 To lCols - 1
'Assumes no blank column names
If Trim(Cells(1, i + 1).Value) = "" Then Exit For
asCols(i) = Cells(1, i + 1).Value
Next i
If i = 0 Then GoTo ErrorHandler
lCols = i
Print #iFileNum, "<" & sName & ">"
For i = 2 To lRows
If Trim(Cells(i, 1).Value) = "" Then Exit For
For j = 1 To lCols
If Trim(Cells(i, j).Value) <> "" Then
Print #iFileNum, Trim(Cells(i, j).Value)
DoEvents 'OPTIONAL
End If
Next j
Next i
Print #iFileNum, "</" & sName & ">"
ExportToXML_C = True
ErrorHandler:
If iFileNum > 0 Then Close #iFileNum
Exit Function
End Function
This codes together with some others codes i have were saved as an Add-
in.
The issue is the above udf only works in excel at cell say E1(as a
UDF). I am trying to incorporate the function into another vba module
like below but I keep getting "Run-time error 1004 Macro cannot be
found".
Sub Run_ExportToXML_C()
ThisWorkbook.Sheets("BorangC2007").Copy
After:=ActiveWorkbook.Sheets("FormC")
With Sheets("BorangC2007")
..Range("D2").Formula = "=IF(ISBLANK('FormC'!R[1]C),"""",UPPER('FormC'!
R[1]C))"
..Range("D3").Formula = "=IF(ISBLANK('FormC'!RC[9]),"""",UPPER('FormC'!
RC[9]))"
..Range("D4").Formula = "=IF(ISBLANK('FormC'!
R[1]C),"""",TEXT(SUBSTITUTE('FormC'!R[1]C,""-"",""""),""0""))"
..Range("E1").Application.Run "ExportToXML_C(""D:\My Documents\Form C
2007.xml"",RC[-4])"
End With
End Sub
Both Private Function ExportToXML_C and Sub Run_ExportToXML_C() are in
the same add-in.
Any help to make it work in vb is very much appreciated.
I am still a learner in excel / vba. I am using XP pro and Microsoft
office 2003.
I have copied this UDF code (Private Function ExportToXML_C) that
exports my current data in an excel spreadsheet into an XML format.
Private Function ExportToXML_C(FullPath As String, RowName _
As String) As Boolean
On Error GoTo ErrorHandler
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
Set oWorkSheet = ActiveWorkbook.Worksheets("BorangC2007")
sName = oWorkSheet.Name
lCols = oWorkSheet.Columns.Count
lRows = oWorkSheet.Rows.Count
ReDim asCols(lCols) As String
iFileNum = FreeFile
Open FullPath For Output As #iFileNum
For i = 0 To lCols - 1
'Assumes no blank column names
If Trim(Cells(1, i + 1).Value) = "" Then Exit For
asCols(i) = Cells(1, i + 1).Value
Next i
If i = 0 Then GoTo ErrorHandler
lCols = i
Print #iFileNum, "<" & sName & ">"
For i = 2 To lRows
If Trim(Cells(i, 1).Value) = "" Then Exit For
For j = 1 To lCols
If Trim(Cells(i, j).Value) <> "" Then
Print #iFileNum, Trim(Cells(i, j).Value)
DoEvents 'OPTIONAL
End If
Next j
Next i
Print #iFileNum, "</" & sName & ">"
ExportToXML_C = True
ErrorHandler:
If iFileNum > 0 Then Close #iFileNum
Exit Function
End Function
This codes together with some others codes i have were saved as an Add-
in.
The issue is the above udf only works in excel at cell say E1(as a
UDF). I am trying to incorporate the function into another vba module
like below but I keep getting "Run-time error 1004 Macro cannot be
found".
Sub Run_ExportToXML_C()
ThisWorkbook.Sheets("BorangC2007").Copy
After:=ActiveWorkbook.Sheets("FormC")
With Sheets("BorangC2007")
..Range("D2").Formula = "=IF(ISBLANK('FormC'!R[1]C),"""",UPPER('FormC'!
R[1]C))"
..Range("D3").Formula = "=IF(ISBLANK('FormC'!RC[9]),"""",UPPER('FormC'!
RC[9]))"
..Range("D4").Formula = "=IF(ISBLANK('FormC'!
R[1]C),"""",TEXT(SUBSTITUTE('FormC'!R[1]C,""-"",""""),""0""))"
..Range("E1").Application.Run "ExportToXML_C(""D:\My Documents\Form C
2007.xml"",RC[-4])"
End With
End Sub
Both Private Function ExportToXML_C and Sub Run_ExportToXML_C() are in
the same add-in.
Any help to make it work in vb is very much appreciated.