I have an access 2003 database that I inherited and I am by no means a VBA pro but I have been getting by. In our database we have VBA code that creates an XML file for us to import into our cloud accounting system, However our accounting system is doing away with XML import in favor of CSV and I am lost. Can anyone maybe help me to convert the below code to export to cvs instead of XML. I have no Idea where to start.
Thanks in advance for your kind assistance.
Private Sub cmdCreateXML_Click()
' Creates smbXML files for import to NetSuite
Dim dbs As Database, rst As Recordset, qdf As QueryDef, strLocation As String, strFileNo As String
Dim strToday As String, strFile As String, intFile As Integer, strQuote As String, iCounter As Integer, qdfInv As QueryDef
Dim strHandle As String, strOffice As String, strDealerName As String, blnDealers As Boolean, blnInvoices As Boolean
Dim jCounter As Integer, rstInv As Recordset, rstDtl As Recordset, curRevenue As Currency, kCounter As Integer, qdfDtl As QueryDef
Dim rstchk As Recordset, intBlankVINs As Integer
Set dbs = CurrentDb
strToday = Format(Date, "yyyymmdd")
' Alert user if there are any blank VINs
Set rstchk = dbs.OpenRecordset("qselBlankVINs", dbOpenSnapshot)
With rstchk
If Not .EOF Then
.MoveLast
intBlankVINs = .RecordCount
If intblanlkvins <> 1 Then
MsgBox "There are " & intBlankVINs & " records without a VIN. Please correct before proceeding.", vbCritical, "Blank VINs Found"
Else
MsgBox "There is " & intBlankVINs & " record without a VIN. Please correct before proceeding.", vbCritical, "Blank VINs Found"
End If
DoCmd.OpenQuery "qselBlankVINs", acViewNormal, acReadOnly
GoTo Exit_cmdCreateXML_Click
End If
End With
' First let's get the date we last exported and make sure we don't overwrite previous data
Set rst = dbs.OpenRecordset("tblDefaults", dbOpenDynaset)
With rst
If Not .EOF Then
.MoveFirst
strLocation = !XMLLocation ' Get the file path to save the exported files
strOffice = !LocationCode ' Use to separate each office's files
' Now check for file number to avoid duplicate files
If strToday = Left(!LastExported, 8) Then
strFileNo = Format(CInt(Right(!LastExported, 2)) + 1, "00") ' if found then increment by 1
Else
strFileNo = "01"
End If
End If
' Now update the data in anticipation of a successful export
.Edit
!LastExported = strToday & strFileNo
.Update
.Close
End With
Set rst = Nothing
' Build the file name and set up the file
strFile = strLocation & strOffice & strToday & strFileNo & ".xml"
On Error Resume Next
Kill strFile
On Error GoTo Err_cmdCreateXML_Click
' Open the file
intFile = FreeFile
Open strFile For Output As intFile
' ***********************************************************
' For all " you must use this technique and replace with """
' ***********************************************************
' Write the header of the XML file
Print #intFile, "<?xml version=" & """1.0""" & " encoding=" & """utf-8""" & "?>"
Print #intFile, "<!DOCTYPE smbxml PUBLIC " & """-//SMBXML//DTD SMBXML 4.06//EN""" & " " & """http://www.netsuite.com/xml/dtd/smb_4_06.dtd""" & ">"
Print #intFile, "<smbxml>"
' Begin writing dealer information
Set rst = dbs.OpenRecordset("qselDealersToExportXML", dbOpenSnapshot)
iCounter = 0
With rst
If Not .EOF Then ' Write dealers one record at a time
blnDealers = True ' Set flag to indicate dealer records were exported
.MoveFirst
Do Until .EOF
iCounter = iCounter + 1
strHandle = strToday & strFileNo & "_Dealer_" & iCounter
Print #intFile, " <request handle=" & """"; strHandle; """" & " missingFieldOverwrite=" & """false""" & ">"
Print #intFile, " <addOrUpdate>"
Print #intFile, " <customer>"
Print #intFile, " <entityId>" & !NetSuiteAcctNo & "</entityId>"
' Check for & character in the Dealer Name and replace if necessary
strDealerName = Replace(!DealerName, "&", "&", , , vbTextCompare)
Print #intFile, " <companyName>" & strDealerName & "</companyName>"
Print #intFile, " <phone>" & !DealerPhone & "</phone>"
Print #intFile, " <fax>" & !DealerFax & "</fax>"
Print #intFile, " <accountNumber>" & !NetSuiteAcctNo & "</accountNumber>"
Print #intFile, " <addressList>"
Print #intFile, " <addressLine>"
Print #intFile, " <addressName>Corporate</addressName>"
Print #intFile, " <line1>" & !DealerAddress & "</line1>"
Print #intFile, " <city>" & !DealerCity & "</city>"
Print #intFile, " <state>" & !DealerSt & "</state>"
Print #intFile, " <zipCode>" & !Zip & "</zipCode>"
Print #intFile, " <phone>" & !DealerPhone & "</phone>"
Print #intFile, " <defaultBilling>TRUE</defaultBilling>"
Print #intFile, " <defaultShipping>TRUE</defaultShipping>"
Print #intFile, " </addressLine>"
Print #intFile, " </addressList>"
Print #intFile, " <customFieldValues>"
Print #intFile, " <customFieldValue name=" & """DMV License No""" & ">" & !DMVLicenseNo & "</customFieldValue>"
Print #intFile, " <customFieldValue name=" & """Dealer Rep""" & ">" & !DealerRep & "</customFieldValue>"
Print #intFile, " </customFieldValues>"
Print #intFile, " </customer>"
Print #intFile, " </addOrUpdate>"
Print #intFile, " </request>"
.MoveNext
Loop
DoCmd.OpenQuery "qupdSetDealersExported" ' Reset dealers
Else
blnDealers = False ' Set flag to indicate no dealers were exported
End If
.Close
Set rst = Nothing
End With
' Get the dates to restrict on and then open our data
Set qdfDtl = dbs.QueryDefs("qselInvoiceItems_XML")
qdfDtl.Parameters("StartDate") = StartDate
qdfDtl.Parameters("EndDate") = EndDate
Set rstDtl = qdfDtl.OpenRecordset(dbOpenDynaset)
Set qdfInv = dbs.QueryDefs("qselInvoiceHeaders_XML")
qdfInv.Parameters("StartDate") = StartDate
qdfInv.Parameters("EndDate") = EndDate
Set rstInv = qdfInv.OpenRecordset(dbOpenDynaset)
'Set rstInv = dbs.OpenRecordset("qselInvoiceHeaders_XML", dbOpenDynaset)
'Set rstDtl = dbs.OpenRecordset("qselInvoiceItems_XML", dbOpenDynaset)
' Cycle through the header then the items to allow grouping transactions on a single invoice
jCounter = 0 ' Reset invoice counter
kCounter = 0 ' Reset line item counter
curRevenue = 0
With rstInv
If Not .EOF Then
blnInvoices = True
.MoveFirst
Do Until .EOF
jCounter = jCounter + 1 ' Used to count the number of invoices
strHandle = strToday & strFileNo & "_Invoice_" & jCounter
Print #intFile, " <request handle=" & """"; strHandle; """" & ">"
Print #intFile, " <add>"
Print #intFile, " <invoice>"
Print #intFile, " <customFormRef>"
Print #intFile, " <name>AutoX Service Invoice</name>"
Print #intFile, " </customFormRef>"
Print #intFile, " <tranId>NetSuiteAutoGenerated</tranId>"
Print #intFile, " <customerRef>"
Print #intFile, " <name>" & !TransID & "</name>"
Print #intFile, " </customerRef>"
Print #intFile, " <tranDate>" & !TransactionDate & "</tranDate>"
Print #intFile, " <toBePrinted>true</toBePrinted>"
Print #intFile, " <termsRef>"
Print #intFile, " <name>Due on receipt</name>"
Print #intFile, " </termsRef>"
Print #intFile, " <locationRef>"
Print #intFile, " <name>" & !Location & "</name>"
Print #intFile, " </locationRef>"
Print #intFile, " <itemList>"
' Now we need to find all the transactions for this dealer
' and put them on the invoice
rstDtl.MoveFirst
rstDtl.FindFirst "TransID = '" & !TransID & "'"
Do Until rstDtl.NoMatch
kCounter = kCounter + 1 ' Count the # of line items on the invoices
Print #intFile, " <itemLine>"
Print #intFile, " <itemRef>"
Print #intFile, " <name>" & rstDtl!Service & "</name>"
Print #intFile, " </itemRef>"
Print #intFile, " <quantity>1</quantity>"
Print #intFile, " <amount>" & rstDtl!Fee & "</amount>"
curRevenue = curRevenue + rstDtl!Fee
Print #intFile, " <classRef>"
Print #intFile, " <name>" & rstDtl!Class & "</name>"
Print #intFile, " </classRef>"
Print #intFile, " <customFieldValues>"
Print #intFile, " <customFieldValue name=" & """Transaction Date""" & ">" & rstDtl!TransactionDate & "</customFieldValue>"
Print #intFile, " <customFieldValue name=" & """VIN""" & ">" & rstDtl!VIN & "</customFieldValue>"
Print #intFile, " <customFieldValue name=" & """Seller""" & ">" & rstDtl!Seller & "</customFieldValue>"
Print #intFile, " <customFieldValue name=" & """Buyer""" & ">" & rstDtl!Buyer & "</customFieldValue>"
Print #intFile, " <customFieldValue name=" & """Model""" & ">" & Replace(rstDtl!Model, "&", "&", , , vbTextCompare) & "</customFieldValue>"
Print #intFile, " <customFieldValue name=" & """Year""" & ">" & rstDtl!Year & "</customFieldValue>"
' Add either seller rep/comm or buyer rep/comm based on value of Service
If (rstDtl!Service = "Buy" And rstDtl!BuyRep <> "") Then
Print #intFile, " <customFieldValue name=" & """Buy Rep""" & ">" & rstDtl!BuyRep & "</customFieldValue>"
Print #intFile, " <customFieldValue name=" & """Buy Commission""" & ">" & rstDtl!BuyCommission & "</customFieldValue>"
End If
If (rstDtl!Service = "Sell" And rstDtl!SellRep <> "") Then
Print #intFile, " <customFieldValue name=" & """Sell Rep""" & ">" & rstDtl!SellRep & "</customFieldValue>"
Print #intFile, " <customFieldValue name=" & """Sell Commission""" & ">" & rstDtl!SellCommission & "</customFieldValue>"
End If
Print #intFile, " </customFieldValues>"
Print #intFile, " </itemLine>"
rstDtl.FindNext "TransID = '" & !TransID & "'"
Loop
Print #intFile, " </itemList>"
Print #intFile, " </invoice>"
Print #intFile, " </add>"
Print #intFile, " </request>"
.MoveNext
Loop
Else
blnInvoices = False
End If
.Close
Set rstInv = Nothing
DoCmd.OpenQuery "qupdSetInvoicesExported_XML"
End With
' Write the final line of the file
Print #intFile, "</smbxml>"
Close #intFile
' Delete file if flags are both false
If (Not blnDealers And Not blnInvoices) Then
Kill strFile
MsgBox "There were no transactions available to export", vbOKOnly, "No Data to Export"
End If
' Alert user of results
MsgBox "XML Export Summary:" & vbCrLf & vbCrLf & _
iCounter & " Dealer(s) changes/additions exported" & vbCrLf & vbCrLf & _
jCounter & " invoice(s) created with" & vbCrLf & _
kCounter & " line item(s) exported for a total revenue of $" & curRevenue & vbCrLf & vbCrLf & _
vbCrLf & "File name and location is: " & strFile, vbInformation, "Export Complete"
Exit_cmdCreateXML_Click:
dbs.Close
Set dbs = Nothing
Exit Sub
Err_cmdCreateXML_Click:
Close #intFile
MsgBox Err.Number & " - " & Err.Description, vbCritical, "cmdCreateXML Error"
Resume Exit_cmdCreateXML_Click
End Sub
Thanks in advance for your kind assistance.
Private Sub cmdCreateXML_Click()
' Creates smbXML files for import to NetSuite
Dim dbs As Database, rst As Recordset, qdf As QueryDef, strLocation As String, strFileNo As String
Dim strToday As String, strFile As String, intFile As Integer, strQuote As String, iCounter As Integer, qdfInv As QueryDef
Dim strHandle As String, strOffice As String, strDealerName As String, blnDealers As Boolean, blnInvoices As Boolean
Dim jCounter As Integer, rstInv As Recordset, rstDtl As Recordset, curRevenue As Currency, kCounter As Integer, qdfDtl As QueryDef
Dim rstchk As Recordset, intBlankVINs As Integer
Set dbs = CurrentDb
strToday = Format(Date, "yyyymmdd")
' Alert user if there are any blank VINs
Set rstchk = dbs.OpenRecordset("qselBlankVINs", dbOpenSnapshot)
With rstchk
If Not .EOF Then
.MoveLast
intBlankVINs = .RecordCount
If intblanlkvins <> 1 Then
MsgBox "There are " & intBlankVINs & " records without a VIN. Please correct before proceeding.", vbCritical, "Blank VINs Found"
Else
MsgBox "There is " & intBlankVINs & " record without a VIN. Please correct before proceeding.", vbCritical, "Blank VINs Found"
End If
DoCmd.OpenQuery "qselBlankVINs", acViewNormal, acReadOnly
GoTo Exit_cmdCreateXML_Click
End If
End With
' First let's get the date we last exported and make sure we don't overwrite previous data
Set rst = dbs.OpenRecordset("tblDefaults", dbOpenDynaset)
With rst
If Not .EOF Then
.MoveFirst
strLocation = !XMLLocation ' Get the file path to save the exported files
strOffice = !LocationCode ' Use to separate each office's files
' Now check for file number to avoid duplicate files
If strToday = Left(!LastExported, 8) Then
strFileNo = Format(CInt(Right(!LastExported, 2)) + 1, "00") ' if found then increment by 1
Else
strFileNo = "01"
End If
End If
' Now update the data in anticipation of a successful export
.Edit
!LastExported = strToday & strFileNo
.Update
.Close
End With
Set rst = Nothing
' Build the file name and set up the file
strFile = strLocation & strOffice & strToday & strFileNo & ".xml"
On Error Resume Next
Kill strFile
On Error GoTo Err_cmdCreateXML_Click
' Open the file
intFile = FreeFile
Open strFile For Output As intFile
' ***********************************************************
' For all " you must use this technique and replace with """
' ***********************************************************
' Write the header of the XML file
Print #intFile, "<?xml version=" & """1.0""" & " encoding=" & """utf-8""" & "?>"
Print #intFile, "<!DOCTYPE smbxml PUBLIC " & """-//SMBXML//DTD SMBXML 4.06//EN""" & " " & """http://www.netsuite.com/xml/dtd/smb_4_06.dtd""" & ">"
Print #intFile, "<smbxml>"
' Begin writing dealer information
Set rst = dbs.OpenRecordset("qselDealersToExportXML", dbOpenSnapshot)
iCounter = 0
With rst
If Not .EOF Then ' Write dealers one record at a time
blnDealers = True ' Set flag to indicate dealer records were exported
.MoveFirst
Do Until .EOF
iCounter = iCounter + 1
strHandle = strToday & strFileNo & "_Dealer_" & iCounter
Print #intFile, " <request handle=" & """"; strHandle; """" & " missingFieldOverwrite=" & """false""" & ">"
Print #intFile, " <addOrUpdate>"
Print #intFile, " <customer>"
Print #intFile, " <entityId>" & !NetSuiteAcctNo & "</entityId>"
' Check for & character in the Dealer Name and replace if necessary
strDealerName = Replace(!DealerName, "&", "&", , , vbTextCompare)
Print #intFile, " <companyName>" & strDealerName & "</companyName>"
Print #intFile, " <phone>" & !DealerPhone & "</phone>"
Print #intFile, " <fax>" & !DealerFax & "</fax>"
Print #intFile, " <accountNumber>" & !NetSuiteAcctNo & "</accountNumber>"
Print #intFile, " <addressList>"
Print #intFile, " <addressLine>"
Print #intFile, " <addressName>Corporate</addressName>"
Print #intFile, " <line1>" & !DealerAddress & "</line1>"
Print #intFile, " <city>" & !DealerCity & "</city>"
Print #intFile, " <state>" & !DealerSt & "</state>"
Print #intFile, " <zipCode>" & !Zip & "</zipCode>"
Print #intFile, " <phone>" & !DealerPhone & "</phone>"
Print #intFile, " <defaultBilling>TRUE</defaultBilling>"
Print #intFile, " <defaultShipping>TRUE</defaultShipping>"
Print #intFile, " </addressLine>"
Print #intFile, " </addressList>"
Print #intFile, " <customFieldValues>"
Print #intFile, " <customFieldValue name=" & """DMV License No""" & ">" & !DMVLicenseNo & "</customFieldValue>"
Print #intFile, " <customFieldValue name=" & """Dealer Rep""" & ">" & !DealerRep & "</customFieldValue>"
Print #intFile, " </customFieldValues>"
Print #intFile, " </customer>"
Print #intFile, " </addOrUpdate>"
Print #intFile, " </request>"
.MoveNext
Loop
DoCmd.OpenQuery "qupdSetDealersExported" ' Reset dealers
Else
blnDealers = False ' Set flag to indicate no dealers were exported
End If
.Close
Set rst = Nothing
End With
' Get the dates to restrict on and then open our data
Set qdfDtl = dbs.QueryDefs("qselInvoiceItems_XML")
qdfDtl.Parameters("StartDate") = StartDate
qdfDtl.Parameters("EndDate") = EndDate
Set rstDtl = qdfDtl.OpenRecordset(dbOpenDynaset)
Set qdfInv = dbs.QueryDefs("qselInvoiceHeaders_XML")
qdfInv.Parameters("StartDate") = StartDate
qdfInv.Parameters("EndDate") = EndDate
Set rstInv = qdfInv.OpenRecordset(dbOpenDynaset)
'Set rstInv = dbs.OpenRecordset("qselInvoiceHeaders_XML", dbOpenDynaset)
'Set rstDtl = dbs.OpenRecordset("qselInvoiceItems_XML", dbOpenDynaset)
' Cycle through the header then the items to allow grouping transactions on a single invoice
jCounter = 0 ' Reset invoice counter
kCounter = 0 ' Reset line item counter
curRevenue = 0
With rstInv
If Not .EOF Then
blnInvoices = True
.MoveFirst
Do Until .EOF
jCounter = jCounter + 1 ' Used to count the number of invoices
strHandle = strToday & strFileNo & "_Invoice_" & jCounter
Print #intFile, " <request handle=" & """"; strHandle; """" & ">"
Print #intFile, " <add>"
Print #intFile, " <invoice>"
Print #intFile, " <customFormRef>"
Print #intFile, " <name>AutoX Service Invoice</name>"
Print #intFile, " </customFormRef>"
Print #intFile, " <tranId>NetSuiteAutoGenerated</tranId>"
Print #intFile, " <customerRef>"
Print #intFile, " <name>" & !TransID & "</name>"
Print #intFile, " </customerRef>"
Print #intFile, " <tranDate>" & !TransactionDate & "</tranDate>"
Print #intFile, " <toBePrinted>true</toBePrinted>"
Print #intFile, " <termsRef>"
Print #intFile, " <name>Due on receipt</name>"
Print #intFile, " </termsRef>"
Print #intFile, " <locationRef>"
Print #intFile, " <name>" & !Location & "</name>"
Print #intFile, " </locationRef>"
Print #intFile, " <itemList>"
' Now we need to find all the transactions for this dealer
' and put them on the invoice
rstDtl.MoveFirst
rstDtl.FindFirst "TransID = '" & !TransID & "'"
Do Until rstDtl.NoMatch
kCounter = kCounter + 1 ' Count the # of line items on the invoices
Print #intFile, " <itemLine>"
Print #intFile, " <itemRef>"
Print #intFile, " <name>" & rstDtl!Service & "</name>"
Print #intFile, " </itemRef>"
Print #intFile, " <quantity>1</quantity>"
Print #intFile, " <amount>" & rstDtl!Fee & "</amount>"
curRevenue = curRevenue + rstDtl!Fee
Print #intFile, " <classRef>"
Print #intFile, " <name>" & rstDtl!Class & "</name>"
Print #intFile, " </classRef>"
Print #intFile, " <customFieldValues>"
Print #intFile, " <customFieldValue name=" & """Transaction Date""" & ">" & rstDtl!TransactionDate & "</customFieldValue>"
Print #intFile, " <customFieldValue name=" & """VIN""" & ">" & rstDtl!VIN & "</customFieldValue>"
Print #intFile, " <customFieldValue name=" & """Seller""" & ">" & rstDtl!Seller & "</customFieldValue>"
Print #intFile, " <customFieldValue name=" & """Buyer""" & ">" & rstDtl!Buyer & "</customFieldValue>"
Print #intFile, " <customFieldValue name=" & """Model""" & ">" & Replace(rstDtl!Model, "&", "&", , , vbTextCompare) & "</customFieldValue>"
Print #intFile, " <customFieldValue name=" & """Year""" & ">" & rstDtl!Year & "</customFieldValue>"
' Add either seller rep/comm or buyer rep/comm based on value of Service
If (rstDtl!Service = "Buy" And rstDtl!BuyRep <> "") Then
Print #intFile, " <customFieldValue name=" & """Buy Rep""" & ">" & rstDtl!BuyRep & "</customFieldValue>"
Print #intFile, " <customFieldValue name=" & """Buy Commission""" & ">" & rstDtl!BuyCommission & "</customFieldValue>"
End If
If (rstDtl!Service = "Sell" And rstDtl!SellRep <> "") Then
Print #intFile, " <customFieldValue name=" & """Sell Rep""" & ">" & rstDtl!SellRep & "</customFieldValue>"
Print #intFile, " <customFieldValue name=" & """Sell Commission""" & ">" & rstDtl!SellCommission & "</customFieldValue>"
End If
Print #intFile, " </customFieldValues>"
Print #intFile, " </itemLine>"
rstDtl.FindNext "TransID = '" & !TransID & "'"
Loop
Print #intFile, " </itemList>"
Print #intFile, " </invoice>"
Print #intFile, " </add>"
Print #intFile, " </request>"
.MoveNext
Loop
Else
blnInvoices = False
End If
.Close
Set rstInv = Nothing
DoCmd.OpenQuery "qupdSetInvoicesExported_XML"
End With
' Write the final line of the file
Print #intFile, "</smbxml>"
Close #intFile
' Delete file if flags are both false
If (Not blnDealers And Not blnInvoices) Then
Kill strFile
MsgBox "There were no transactions available to export", vbOKOnly, "No Data to Export"
End If
' Alert user of results
MsgBox "XML Export Summary:" & vbCrLf & vbCrLf & _
iCounter & " Dealer(s) changes/additions exported" & vbCrLf & vbCrLf & _
jCounter & " invoice(s) created with" & vbCrLf & _
kCounter & " line item(s) exported for a total revenue of $" & curRevenue & vbCrLf & vbCrLf & _
vbCrLf & "File name and location is: " & strFile, vbInformation, "Export Complete"
Exit_cmdCreateXML_Click:
dbs.Close
Set dbs = Nothing
Exit Sub
Err_cmdCreateXML_Click:
Close #intFile
MsgBox Err.Number & " - " & Err.Description, vbCritical, "cmdCreateXML Error"
Resume Exit_cmdCreateXML_Click
End Sub