Hello and welcome to our community! Is this your first visit?
Register
Enjoy an ad free experience by logging in. Not a member yet? Register.
Results 1 to 2 of 2
  1. #1
    Regular Coder
    Join Date
    Jun 2002
    Location
    -27 28' 22" , 153 1' 22"
    Posts
    135
    Thanks
    0
    Thanked 0 Times in 0 Posts

    MS Access VBA Code

    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
    "Computers are considered female - As soon as you make a commitment to one, you find yourself spending half your paycheck on accessories for it."

  • #2
    Regular Coder
    Join Date
    Jun 2002
    Location
    -27 28' 22" , 153 1' 22"
    Posts
    135
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Question

    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
    "Computers are considered female - As soon as you make a commitment to one, you find yourself spending half your paycheck on accessories for it."


  •  

    Tags for this Thread

    Posting Permissions

    • You may not post new threads
    • You may not post replies
    • You may not post attachments
    • You may not edit your posts
    •