Need help to save files as XML

[silverback24]

I am trying to put together an excel workbook that our customer service can fill in a spreadsheet and then convert all the data to XML and put into a folder. The issue comes in that we can have up to 12 parts included in the item field. The XML maps this as a vertical drop down as opposed to a horizontal spreadsheet.
Thanks in advance! Sorry for wall of text.

<sbcpartorderrequest><shipto><state>XML won't paste with code.
</state></shipto></sbcpartorderrequest>

I have a macro put together, that works, but saves them as text files. Is there a way to convert my macro to save as XML or is there another way to do this?
Macro:
Sub Macro1()
'
' Macro1 Macro
'

'
Dim n As Integer
Dim r As Integer
Dim Fname As String
n = 1
r = 2

'Data filled in by reps will be horizontal, then transpose pasted into another sheet with the xml prefix and suffix in columns A and C
Workbooks("Credit Memo Workbook.XLSM").Activate
Sheets("Credit Memo Data").Select
For Each Cell In Sheets("Credit Memo Data").Range("C2:C500")
If Cell.Value = "CREDIT" Then
Fname = "H:\Desktop\" & "CRDA " & Format(Date, "ddmmyyyy") & " - " & n & ".txt"

Sheets("Credit Memo Data").Select
Rows(r & ":" & r).Select
Selection.Copy

Sheets("Credit Memo Build Sheet").Select
Range("B1").Select
Sheets("Credit Memo Build Sheet").Range("B1").PasteSpecial Paste:=xlPasteValues, Transpose:=True

'Paste to a new workbook
'column D has a concatenate formula pulling columns A,B,C
Worksheets("Credit Memo Build Sheet").Range("D:D").Copy
Workbooks.Add
Sheets("Sheet1").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:=Fname, FileFormat:=xlText
ActiveWorkbook.Close SaveChanges:=False
n = n + 1
r = r + 1

Else
Exit Sub

End If
Next
End Sub

 

[snowman052]

ActiveWorkbook.SaveAs Filename:=Fname &".xlm"

should do the trick, remove fileformat

 

[snowman052]

Dim Fname As String to Dim Filename As String

ActiveWorkbook.SaveAs Filename:=Fname, FileFormat:=xlText to ActiveWorkbook.SaveAs Filename & ".xlm"

 

[silverback24]

I am now getting an error when I try to open these files that says the file format and extension of 'CRDA 30062014 - 3.xlm' don't match. The file could be corrupted or unsafe.....
When I open with anything other that excel I get wing ding characters.

When I save with ".xml" it runs but adds a lot of other text and isn't recognizable as my original xml files.

Code as of now:
Sub Macro1()
'
' Macro1 Macro
'

'
Dim n As Integer
Dim r As Integer
Dim Filename As String
n = 1
r = 2
'Fname = "F:\Users\Clint\Desktop\work stuff\" & "CRDA " & Format(Date, "ddmmyyyy") & " - " & n & ".txt"

Workbooks("Credit Memo Workbook.XLSM").Activate
Sheets("Credit Memo Data").Select
For Each Cell In Sheets("Credit Memo Data").Range("C2:C500")
If Cell.Value = "CREDIT" Then
Filename = "H:\Desktop\" & "CRDA " & Format(Date, "ddmmyyyy") & " - " & n

Sheets("Credit Memo Data").Select
Rows(r & ":" & r).Select
Selection.Copy

Sheets("Credit Memo Build Sheet").Select
Range("B1").Select
Sheets("Credit Memo Build Sheet").Range("B1").PasteSpecial Paste:=xlPasteValues, Transpose:=True

'Paste to a new workbook
Worksheets("Credit Memo Build Sheet").Range("D:D").Copy
Workbooks.Add
Sheets("Sheet1").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename & ".xlm"
ActiveWorkbook.Close SaveChanges:=False
n = n + 1
r = r + 1

Else
Exit Sub

End If
Next
End Sub

 

[silverback24]

Ok, I have adapted my macro to utilize two connector pages so that the credits come out correctly. My issue now is the XML header. Our database will not accept the files if they start with:
<!--?xml version="1.0" encoding="UTF-8" standalone="yes"?--> <sbcpartorderrequest xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"><sbcpartorderrequest xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">(?xml version="1.0" encoding="UTF-8" standalone="yes"?)
(SBCPartOrderRequest xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance")

I need it to only start with:
<sbcpartorderrequest><sbcpartorderrequest>(SBCPartOrderRequest)
Changed < and > to ( and ). Any ideas?</sbcpartorderrequest></sbcpartorderrequest></sbcpartorderrequest></sbcpartorderrequest>

 

[snowman052]

Beyond my area, but ripped this code. Does it help.


<code>Dim DoubleQuote : DoubleQuote = Chr(34) Dim strHeader : strHeader = "<?xml version=" & DoubleQuote & "1.0" & DoubleQuote & " encoding=" & DoubleQuote & "UTF-8" & DoubleQuote & "?>" Result = replace(strHeader,strHeader,"") If Result = "" then MsgBox "Header stripped!" Else MsgBox "Failed to strip header." End If</code></pre>

 

[silverback24]

Thank you for your response. I saw that one as well but was unable to incorporate it into my macro. Does anyone know If I can alter the XML produced by adding this after the export or if I will need to open the file and then run a replace code?