I am working on project with very limited vba knowledge. I am trying to pull data from sql to excel and convert that to XML by using a vba macro code to import it to the program by using built in import function.
my problem is one account have multiple contacts and in XML I want to create a single <account> ta for each account number with multiple <contact> tags under it. tis is the VBA
' ----------------------------------------------------------------------------------------
' DATA DIVISION
Public Accountrow As Integer
Public AccountCode As String
Public CreditorCode As String
Public AccountName As String
Public AccountCurrency As String
Public AccountResource As String
Public AccountEmployee As String
Public Classification As String
Public Sector As String
Public Subsector As String
Public Size As String
Public Rating As String
Public Source As String
Public TitleCode As String
Public MVO As String
Public LastName As String
Public FirstName As String
Public Jobdescription As String
Public CountryCode As String
Public CountryName As String
Public Address1 As String
Public Address2 As String
Public Address3 As String
Public PostalCode As String
Public City As String
Public State As String
Public Phone As String
Public Fax As String
Public eMail As String
Public Homepage As String
Public AccountManager As String
Public CreditLimit As String
Public PaymentCD As String
Public ABN As String
Public Status As String
Public crdnr As String
Public BankAcc As String
Public freetext01 As String
Public CntType As String
Public CntMain As String
Public CntPhone As String
Public CntFax As String
Public CntMobile As String
Public CntEmail As String
Public CntPostCode As String
Sub backupConvertToXML()
' ----------------------------------------------------------------------------------------
' Create output file as an object in the system with the file name c:\\CREDITORS.xml
' If this file exists, it will be overwritten without questions asked
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("D:\\Globe_Common\\Database Cutover\\XML Imports\\CREDITORS.xml", True)
' ----------------------------------------------------------------------------------------
' Write xml header
a.WriteLine ("\<?xml version=""1.0"" ?\>")
a.WriteLine ("\<eExact xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xsi:noNamespaceSchemaLocation=""eExact-Schema.xsd""\>")
a.WriteLine ("\<Accounts\>")
' ----------------------------------------------------------------------------------------
' Step 1: initialize
' ----------------------------------------------------------------------------------------
AccountCurrency = Worksheets("Accounts").Cells(2, 2)
AccountResource = Worksheets("Accounts").Cells(4, 2)
' ----------------------------------------------------------------------------------------
' Step 2: Write records for Creditors
' ----------------------------------------------------------------------------------------
Accountrow = 12
While Worksheets("Accounts").Cells(Accountrow, 1) \<\> Empty
CreditorCode = Worksheets("Accounts").Cells(Accountrow, 1)
AccountCode = Worksheets("Accounts").Cells(Accountrow, 1)
' CreditorCode must be numeric but we save them as strings with leading spaces. Funny, not?
While Len(CreditorCode) \< 6
CreditorCode = " " & CreditorCode
Wend
' AccountCode must be numeric but we save them as strings with leading spaces. Funny, not?
While Len(AccountCode) \< 20
AccountCode = " " & AccountCode
Wend
AccountName = Worksheets("Accounts").Cells(Accountrow, 2)
Classification = Worksheets("Accounts").Cells(Accountrow, 3)
Sector = Worksheets("Accounts").Cells(Accountrow, 4)
Subsector = Worksheets("Accounts").Cells(Accountrow, 5)
Size = Worksheets("Accounts").Cells(Accountrow, 6)
Rating = Worksheets("Accounts").Cells(Accountrow, 7)
Source = Worksheets("Accounts").Cells(Accountrow, 8)
TitleCode = Worksheets("Accounts").Cells(Accountrow, 9)
MVO = Worksheets("Accounts").Cells(Accountrow, 10)
LastName = Worksheets("Accounts").Cells(Accountrow, 11)
FirstName = Worksheets("Accounts").Cells(Accountrow, 12)
Jobdescription = Worksheets("Accounts").Cells(Accountrow, 13)
CountryCode = Worksheets("Accounts").Cells(Accountrow, 14)
CountryName = Worksheets("Accounts").Cells(Accountrow, 15)
Address1 = Worksheets("Accounts").Cells(Accountrow, 16)
Address2 = Worksheets("Accounts").Cells(Accountrow, 17)
Address3 = Worksheets("Accounts").Cells(Accountrow, 18)
PostalCode = Worksheets("Accounts").Cells(Accountrow, 19)
City = Worksheets("Accounts").Cells(Accountrow, 20)
State = Worksheets("Accounts").Cells(Accountrow, 21)
Phone = Worksheets("Accounts").Cells(Accountrow, 22)
Fax = Worksheets("Accounts").Cells(Accountrow, 23)
eMail = Worksheets("Accounts").Cells(Accountrow, 24)
Homepage = Worksheets("Accounts").Cells(Accountrow, 25)
AccountResource = Worksheets("Accounts").Cells(Accountrow, 26)
CreditLimit = Worksheets("Accounts").Cells(Accountrow, 27)
PaymentCD = Worksheets("Accounts").Cells(Accountrow, 28)
ABN = Worksheets("Accounts").Cells(Accountrow, 29)
Status = Worksheets("Accounts").Cells(Accountrow, 30)
crdnr = Worksheets("Accounts").Cells(Accountrow, 1)
BankAcc = Worksheets("Accounts").Cells(Accountrow, 32)
freetext01 = Worksheets("Accounts").Cells(Accountrow, 33)
CntType = Worksheets("Accounts").Cells(Accountrow, 34)
CntMain = Worksheets("Accounts").Cells(Accountrow, 35)
CntPhone = Worksheets("Accounts").Cells(Accountrow, 36)
CntFax = Worksheets("Accounts").Cells(Accountrow, 37)
CntMobile = Worksheets("Accounts").Cells(Accountrow, 38)
CntEmail = Worksheets("Accounts").Cells(Accountrow, 40)
CntPostCode = Worksheets("Accounts").Cells(Accountrow, 41)
Call WriteRecord(a)
Accountrow = Accountrow + 1
Wend
' ----------------------------------------------------------------------------------------
' Step 3: End file
' ----------------------------------------------------------------------------------------
a.WriteLine ("\</Accounts\>")
a.WriteLine ("\</eExact\>")
a.Close
End Sub
Private Sub WriteRecord(ByVal a As Object)
Dim LongText As String
' Type = "S" means "Supplier"!
a.WriteLine (" \<Account code=""" & AccountCode & """ status=""" & Status & """ type=""S""\>")
a.WriteLine (" \<Name\>" & AccountName & "\</Name\>")
a.WriteLine (" \<Phone\>" & Phone & "\</Phone\>")
a.WriteLine (" \<Fax\>" & Fax & "\</Fax\>")
a.WriteLine (" \<Email\>" & eMail & "\</Email\>")
a.WriteLine (" \<HomePage\>" & Homepage & "\</HomePage\>")
a.WriteLine (" <Contacts>")
a.WriteLine (" <Contact default=""" & CntMain & """ gender=""" & MVO & """ status=""A"">")
a.WriteLine (" <LastName>" & LastName & "</LastName>")
a.WriteLine (" <FirstName>" & FirstName & "</FirstName>")
a.WriteLine (" <Title code=""" & TitleCode & """/>")
a.WriteLine (" <Addresses>")
a.WriteLine (" <Address type=""" & CntType & """ desc="""">")
a.WriteLine (" <AddressLine1>" & Address1 & "</AddressLine1>")
a.WriteLine (" <AddressLine2>" & Address2 & "</AddressLine2>")
a.WriteLine (" <AddressLine3>" & Address3 & "</AddressLine3>")
a.WriteLine (" <PostalCode>" & CntPostCode & "</PostalCode>")
a.WriteLine (" <City>" & City & "</City>")
a.WriteLine (" <State code=""" & State & """/>")
a.WriteLine (" <Country code=""" & CountryCode & """/>")
a.WriteLine (" </Address>")
a.WriteLine (" </Addresses>")
a.WriteLine (" <Phone>" & CntPhone & "</Phone>")
a.WriteLine (" <Fax>" & CntFax & "</Fax>")
a.WriteLine (" <Mobile>" & CntMobile & "</Mobile>")
a.WriteLine (" <Email>" & CntEmail & "</Email>")
a.WriteLine (" </Contact>")
a.WriteLine (" </Contacts>")
a.WriteLine (" <Manager number=""" & AccountResource & """>")
a.WriteLine (" </Manager>")
a.WriteLine (" <Creditor number=""" & crdnr & """ code=""" & AccountCode & """>")
a.WriteLine (" <Currency code=""" & AccountCurrency & """/>")
a.WriteLine (" <SecurityLevel>10</SecurityLevel>")
a.WriteLine (" <BankAccounts>")
a.WriteLine (" <BankAccount code=""" & BankAcc & """ default=""" & "1" & """>")
a.WriteLine (" <BankAccountType code=""" & "DEF" & """ checktype=""" & "N" & """>")
a.WriteLine (" <Description>" & "Default bank account type" & "</Description>")
a.WriteLine (" </BankAccountType>")
a.WriteLine (" <Currency code=""" & "AUD" & """/>")
a.WriteLine (" </BankAccount>")
a.WriteLine (" </BankAccounts>")
a.WriteLine (" <CreditLine>" & CreditLimit & "</CreditLine>")
a.WriteLine (" <VATNumber>" & ABN & "</VATNumber>")
a.WriteLine (" </Creditor>")
a.WriteLine (" <VATFixed>0</VATFixed>")
a.WriteLine (" <VATLiability>L</VATLiability>")
a.WriteLine (" <PaymentCondition code=""" & PaymentCD & """/>")
a.WriteLine (" <CompanySize code=""" & Size & """/>")
a.WriteLine (" <CompanyOrigin code=""" & Source & """/>")
a.WriteLine (" <CompanyRating number=""" & Rating & """/>")
a.WriteLine (" <AccountCategory code=""" & Classification & """/>")
a.WriteLine (" <FreeFields>")
a.WriteLine (" <FreeTexts>")
a.WriteLine (" <FreeText number=""" & "1" & """>" & freetext01 & "</FreeText>")
a.WriteLine (" </FreeTexts>")
a.WriteLine (" </FreeFields>")
a.WriteLine (" </Account>")
End Sub
this is screen shot of the spreadsheet
and this is the screen shot of the XML
as you can see <Account code=" 1042" status="A" type="S"> is repeating but I am trying to achieve that creates only one tag every time account number changes.
I hope someone can help me to resolve this as I am running out of time and I am desperate. Thanks in advance.
tried while / if / end if / wend around the account tag but as I said I am inexperienced in vba and couldn't get the right result. Please help.
