Why doesn't "DoCmd.TransferText" method on an Access object import ALL the characters in a CSV file field into an Access Database memo field?

Option Explicit
 
Public Function ExportCal2XML(cXMLFile As String, Optional datStart As Date, Optional datEnd As Date) As Integer
Const NODE_PROCESSING_INSTRUCTION = 7
Const NODE_ELEMENT = 1
Dim cTemp As String
 
Dim objDOM As Object, _
    objCalendar As Object, _
    objCal As Object, _
    objP As Object, _
    objData As Object, _
    olkItems As outlook.Items, _
    olkAppt As outlook.AppointmentItem, _
    intCount As Integer, _
    cStartDate As String, _
    cStartTime As String, _
    cEndDate As String, _
    cEndTime As String
 
intCount = Day(Date) - 1
If IsMissing(datStart) Then
  datStart = DateAdd("d", -intCount, Date)
  datEnd = DateAdd("m", 3, datStart)
End If
 
' Create the main xml node '
Set objDOM = CreateObject("MSXML2.DOMDocument")
Set objCalendar = objDOM.createNode(NODE_PROCESSING_INSTRUCTION, "xml", "")
objDOM.appendChild objCalendar
   
' Create the Parent Node - "calendar" '
Set objCalendar = objDOM.createNode(NODE_ELEMENT, "Calendar", "")
   
' Create a child node - "cal" '
Set objCal = objDOM.createNode(NODE_ELEMENT, "cal", "")
   
' Get the Outlook calendar items '
Set olkItems = Session.GetDefaultFolder(olFolderCalendar).Items.Restrict("[Start] > '" & Format(datStart & " 0:01am", "ddddd h:nn AMPM") & "' AND [Start] < '" & Format(datEnd & " 23:59pm", "ddddd h:nn AMPM") & "'")
olkItems.Sort "[Start]"
For Each olkAppt In olkItems
    DoEvents
    Set objP = objDOM.createNode(NODE_ELEMENT, "Calendar", "")
    objCal.appendChild objP
    
    ' Add Subject '
    Set objData = objDOM.createNode(NODE_ELEMENT, "Subject", "")
    If Len(olkAppt.SUBJECT) = 0 Then olkAppt.SUBJECT = Space$(10)
    objData.Text = olkAppt.SUBJECT
    objP.appendChild objData
    
    ' Add Start Date '
    Set objData = objDOM.createNode(NODE_ELEMENT, "StartDate", "")
    objData.Text = Left(olkAppt.Start, 10)
    objP.appendChild objData
    
    ' Add Start Time '
    Set objData = objDOM.createNode(NODE_ELEMENT, "StartTime", "")
    cTemp = Mid$(olkAppt.Start, 11)
    If Len(cTemp) = 0 Then cTemp = Space$(10)
    objData.Text = cTemp
    objP.appendChild objData
    
    ' Add End Date '
    Set objData = objDOM.createNode(NODE_ELEMENT, "EndDate", "")
    objData.Text = Left(olkAppt.End, 10)
    objP.appendChild objData
    
    ' Add End Time '
    Set objData = objDOM.createNode(NODE_ELEMENT, "EndTime", "")
    cTemp = Mid$(olkAppt.End, 11)
    If Len(cTemp) = 0 Then cTemp = Space$(10)
    objData.Text = cTemp
    objP.appendChild objData
    
    ' Add All Day Event '
    Set objData = objDOM.createNode(NODE_ELEMENT, "AllDayEvent", "")
    objData.Text = olkAppt.AllDayEvent
    objP.appendChild objData
    
    ' Add Description '
    Set objData = objDOM.createNode(NODE_ELEMENT, "Description", "")
    If Len(olkAppt.Body) = 0 Then olkAppt.Body = Space$(10)
    objData.Text = olkAppt.Body
    objP.appendChild objData
    
    ' Add Categories '
    Set objData = objDOM.createNode(NODE_ELEMENT, "Categories", "")
    cTemp = olkAppt.CATEGORIES
    If Len(cTemp) = 0 Then cTemp = Space$(10)
    objData.Text = cTemp
    objP.appendChild objData
    
    'Add Location
    Set objData = objDOM.createNode(NODE_ELEMENT, "Location", "")
        If Len(olkAppt.LOCATION) = 0 Then olkAppt.LOCATION = Space$(10)
    objData.Text = olkAppt.LOCATION
    objP.appendChild objData
    ' Add the data to the Cal node '
    
    objCal.appendChild objP
    Set objP = Nothing
    intCount = intCount + 1
Next
   
 ' Append "Cal" to "Calendar" '
 objCalendar.appendChild objCal
 Set objCal = Nothing
   
 ' Append "Calendar" to the XML Dom Document '
 objDOM.appendChild objCalendar
 Set objCalendar = Nothing
   
 ' Change the name and path of the output file.'
 objDOM.Save cXMLFile
  
 ' Cleanup '
 Set objDOM = Nothing
 Set objCalendar = Nothing
 Set objCal = Nothing
 Set objP = Nothing
 Set objData = Nothing
 Set olkItems = Nothing
 Set olkAppt = Nothing
 
 ExportCal2XML = intCount
End Function
 
'=======================================================================
 
 
Option Explicit
 
Public Function CreateDatabase() As Workspace
'Note: the creation of the indexes at the end of the
'function are not really required since the data being imported
'will already be in date and time order (the way Outlook exports its data)
 
Dim myDB As Database, MyWs As Workspace
Dim CalTd As TableDef
Dim CalFlds(21) As Field
Dim CalIdx As Index
Dim CalQuery As QueryDef
Dim SQLstr As String
Dim fs as object
Dim x As Integer
 
'Set up a file pointer to the database file
Set fs = CreateObject("Scripting.FileSystemObject")
'If the file exists then erase the file
If fs.FileExists("C:\StThomasTheApostle.mdb") Then
  Kill "C:\StThomasTheApostle.mdb"
End If
 
Set MyWs = DBEngine.Workspaces(0)
 
Set myDB = MyWs.CreateDatabase("C:\StThomasTheApostle.mdb", dbLangGeneral, dbVersion30)
 
Set CalTd = myDB.CreateTableDef("Calendar")
 
Set CalFlds(0) = CalTd.CreateField("Subject", dbText)
Set CalFlds(1) = CalTd.CreateField("StartDate", dbText)
Set CalFlds(2) = CalTd.CreateField("StartTime", dbText)
Set CalFlds(3) = CalTd.CreateField("EndDate", dbText)
Set CalFlds(4) = CalTd.CreateField("EndTime", dbText)
Set CalFlds(5) = CalTd.CreateField("AllDayEvent", dbInteger)
Set CalFlds(6) = CalTd.CreateField("Categories", dbText)
Set CalFlds(7) = CalTd.CreateField("Description", dbMemo)
Set CalFlds(8) = CalTd.CreateField("Location", dbMemo)
For x = 0 To 8
  CalTd.Fields.Append CalFlds(x)
Next
myDB.TableDefs.Append CalTd
 
SQLstr = "Select * from Calendar where [StartDate] >= " + CStr(frmMain.CalendarFrom.Value) + _
         " and [StartDate] <= " + CStr(frmMain.CalendarTo.Value) + " order by [StartDate],[StartTime],[Categories]"
 
CreateIndexes
End Function
 
Public Function CreateIndexes()
Dim myDB As Database, MyWs As Workspace
Dim CalTd As TableDef
Dim CalIdx As Index
Dim x As Integer
 
Set MyWs = DBEngine.Workspaces(0)
 
Set myDB = MyWs.OpenDatabase("C:\StThomasTheApostle.mdb")
Set CalTd = myDB.TableDefs(0)
 
With CalTd
  ' Create new index, create and append Field
  ' objects to its Fields collection.
  Set CalIdx = CalTd.CreateIndex("Calendar")
 
  With CalIdx
    .Fields.Append .CreateField("StartDate")
    .Fields.Append .CreateField("StartTime")
    .Fields.Append .CreateField("Categories")
  End With
 
  ' Add new Index object to the Indexes collection
  .Indexes.Append CalIdx
  .Indexes.Refresh
End With
End Function
 
'=======================================================================
 
 
Option Explicit
 
Public Function ImportXMLFile(cXMLFile As String, cDatabaseFileName As String, cTableName As String) As Integer
 
'This subroutine imports data from a comma delimited file (Windows Format)
'into an Access database.
'    The three required parameters are:
'        1. the name of the XML file to be imported (cFileName)
'                        (e.g. "C:\MyData\Calendar.XML")
'        2. the name of the database (cDatabaseFileName)
'                        (e.g. "C:\MyDatabases\MyDataBase.mdb")
'         3. the name of the Table within that database into which the
'             delimited file is to be imported (e.g. "Calendar")
 
Dim MyWs As Workspace             'Pointer to workspace area in which Access
                                                    'database will open
 
Dim accApp As Access.Application  'Pointer to Access database
 
Dim fs As Object                             'File pointer for Import File (cFileName)
 
'Set up a workspace in which to open the Access Database
Set MyWs = DBEngine.Workspaces(0)
 
'Set up a pointer to the Access database
Set accApp = CreateObject("Access.application")
 
'If Access 10 (97) or later then we can turn off
'the security alert that annoyingly pops up
If accApp.Version >= 10 Then
   accApp.AutomationSecurity = 1 ' msoAutomationSecurityLow
End If
 
'Open the Access database
accApp.OpenCurrentDatabase cDatabaseFileName
 
'Set up a file pointer to the text file
Set fs = CreateObject("Scripting.FileSystemObject")
'If the file exists then import the data
If fs.FileExists(cXMLFile) Then
  accApp.ImportXML cXMLFile, acAppendData
End If
 
accApp.CloseCurrentDatabase
 
'Release the pointers
Set fs = Nothing
Set accApp = Nothing
Set MyWs = Nothing
 
End Function

Select allOpen in new window