MS Access VBA Code

[JustAsking]

I'm creating an MS Excel file and populating the file with data from an MS Access database.

What I'm finding is that when the access data is written to the excel file it is being truncated at 255 chars.

What I have tried so far is:


Create a recordset using a query - data is truncated e.g. SELECT * FROM qryFileCCCODE


Create a recodset selecting values directly from a table - data is not truncated e.g. SELECT CCCODE.[Code Type], CCCODE.[Code Value] FROM CCCODE


Create a recodset selecting values directly from a table and appending values to the end of some fields - data is truncated e.g. SELECT CCCODE.[Code Type], CCCODE.[Code Value], CCCODE.[Manager ID] & ""OS100000"" AS [Manager ID] FROM CCCODE


When either using a query or selecting values directly from a table, all the data is selected, it's when the data is written to the excel file that it's truncated.

I was originally using '.CopyFromRecordset rs' to write the data to the excel file but thought this may be the problem. So I changed to looping through each record, but still doesn't work.

Is there a field length limitation, or am I not doing this correctly?

Below is the core part of the code used in the function to create the excel file.


' generate CCCODE file
Call PopulateDataCCCODE 'update some tables with data before exporting
strFileName = strFolder & "CCCODE.xls"
'strSQL = "SELECT * FROM qryFileCCCODE"
strSQL = "SELECT CCCODE.[Code Type], CCCODE.[Code Value], CCCODE.Description, CCCODE.Active, CCCODE.[Manager ID] & ""OS100000"" AS [Manager ID], "
strSQL = strSQL & "CCCODE.[Report Code], ""'"" & CCCODE.Company AS [Company], CCCODE.[Ext Descr], CCCODE.[Parent Code Type], CCCODE.[Parent Code Value], "
strSQL = strSQL & "CCCODE.[Parent Hierarchy Active], CCCODE.[Charge Group] & ""^CON_All Charge Groups"" AS [Charge Group], CCCODE.[Approval Thresholds] & ""50000"" AS [Approval Thresholds] "
strSQL = strSQL & "FROM CCCODE"


rs.Open strSQL, gcnLocal, adOpenStatic, adLockOptimistic
'save data as Excel file
gAppExcel.Workbooks.Add
Set gWorkbook = gAppExcel.ActiveWorkbook
Set gWorksheet = gWorkbook.ActiveSheet
'Write Column Headers
For intF = 1 To rs.Fields.count
gWorksheet.Cells(1, intF).Value = rs.Fields(intF - 1).Name
Next

'Write Column Values
Dim rowCount As Integer
rowCount = 2

If rs.RecordCount > 0 Then
rs.MoveFirst
Do While Not rs.EOF
For intF = 1 To rs.Fields.count
gWorksheet.Cells(rowCount, intF).Value = rs.Fields(intF - 1).Value
Next
rowCount = rowCount + 1
rs.MoveNext
Loop
End If

'gWorksheet.Cells(2, 1).CopyFromRecordset rs
rs.Close
gAppExcel.Selection.CurrentRegion.Columns.AutoFit
On Error Resume Next
gWorkbook.SaveAs strFileName
On Error GoTo ErrorHandler

[JustAsking]

I have also tried using ActiveSheet.QueryTables.Add but this still doesn't work.

Any suggestions?


' Define a new Web Query
Set QT = ActiveSheet.QueryTables.Add(Connection:=ConnectString, Destination:=Range("A1"))
With QT
.Name = MyName
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingAll
.WebTables = "7"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
End With