MS Access VBA Code

JustAsking · 03-16-2009, 03:23 AM

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.

Code:

    ' 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 · 03-17-2009, 11:55 PM

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

Any suggestions?

Code:

' 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