[SIZE="1"]Option Compare Database
Option Explicit
'******************************************************** Dec 14 2013 *****
'
' This class exposes an import spec for customer's Excel files. Pass
' the filename to the Load function.
'
'**************************************************************************
Private Const SPEC_NAME As String = "CustomerXLSImport"
Private m_cols
Private m_base
Private m_spec As String
'******************************************************** Dec 14 2013 *****
'
' Properties
'
'**************************************************************************
Private Property Get ImportSpecXML() As String
' this exposes the final XML by inserting the source file name
ImportSpecXML = Replace(BaseSpecXML, "<filespec>", m_spec)
End Property
Private Property Get Columns()
' this lets me edit the columns if they change in the source doc
If IsEmpty(m_cols) Then m_cols = Split("docid billto coname street1 street2 city state zip country terms custpono email phone item descrip orderqty ourprice linenum needby shipvia QTYtoShip Shipnote")
Columns = m_cols
End Property
Private Property Get BaseSpecXML() As String
' this constructs the base XML for the spec, but note that the filename property is not set
If IsEmpty(m_base) Then
Dim var
Dim tmp As String
Dim i As Integer
i = 1
tmp = _
"<?xml version=""1.0"" encoding=""utf-8"" ?> " & vbCrLf & _
"<ImportExportSpecification Path=""<filespec>"" xmlns=""urn:www.microsoft.com/office/access/imexspec""> " & vbCrLf & _
" <ImportExcel FirstRowHasNames=""true"" AppendToTable=""XLSRawData"" Range=""Sheet1$"" > " & vbCrLf & _
" <Columns PrimaryKey=""{Auto}""> " & vbCrLf & _
" <Column Name=""Col1"" FieldName=""FileID"" Indexed=""YESDUPLICATES"" SkipColumn=""false"" DataType=""Long"" /> " & vbCrLf
For Each var In Columns
i = i + 1
tmp = tmp & " <Column Name=""Col" & i & """ FieldName=""" & var & """ Indexed=""NO"" SkipColumn=""false"" DataType=""Text"" /> " & vbCrLf
Next
m_base = tmp & _
" </Columns>" & vbCrLf & _
" </ImportExcel>" & vbCrLf & _
"</ImportExportSpecification>"
End If
BaseSpecXML = m_base
End Property
'******************************************************** Dec 14 2013 *****
'
' Methods
'
'**************************************************************************
Function Load(filespec As String) As cXLSFileImportSpec
' receives the filespec and returns the instance
m_spec = filespec
Set Load = Me
End Function
Function Execute() As Boolean
' clears the specs collection, adds this spec, and executes it
On Error GoTo handler
Clear
With CurrentProject.ImportExportSpecifications
.Add SPEC_NAME, ImportSpecXML
.Item(SPEC_NAME).Execute
End With
Execute = True
Exit Function
handler:
Err.Raise Err, Err.Source & " cXLSFileImportSpec.Execute"
End Function
Private Sub Clear()
' clears any previously existing instance of the import spec
Dim i As Integer
With CurrentProject.ImportExportSpecifications
For i = .Count - 1 To 0 Step -1
If .Item(i).name = SPEC_NAME Then
.Item(i).Delete
Exit For
End If
Next
End With
End Sub
Function ToString() As String
ToString = ImportSpecXML
End Function[/SIZE]