Export to Excel 1000 Character Limit

[Radioactiveduck]

Alright, so I have a form with a group of combo boxes. Each one of these combo boxes allows the user to select a field from the table "Customers" that they want exported to excel. When they hit the "Export to Excel" button, the export code executes. This normally works fine, with the exception of whenever the user selects a certain field from the Customers table. The field is called "Notes" and contains any anecdotal note data the user cares to record. After error trapping and allowing the program to export whatever data it could from the "Notes" field, I've deduced that it won't export a record when there are more than 1000 characters stored in it. I just can't figure out why, or how I can get around this bug. Here is the code:

Option Compare Database

Private Sub cmd_ExcelExport_Click()

'--------------------------------------------------------------
'VBA code started by NRS on 01/07/2010
'
'The purpose of this code is to allow users to export data from
'various fields in the Customers Table and any other relevent
'tables to documents in Microsoft Excel or Word
'--------------------------------------------------------------


'--------------------------------------------------------------
'Set up error trapping
On Error Resume Next
'--------------------------------------------------------------


'--------------------------------------------------------------
'Declaring Variables
'
'Create and establish the database and recordset variables
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
'
'Create and establish the excel workbook variables
Dim objApp As New Excel.Application
Dim objBook As New Excel.Workbook
Dim objSheet As New Excel.WorkSheet
'
'Declare string, integer, and array variables
Dim xExportArray
Dim strVarString As String, strSQL As String
Dim i As Integer, c As Integer, xColCount As Integer
xColCount = 0
i = 0
'
'Declare other variables
Dim xCtrl As Control
Dim xShowMessage As Boolean
'--------------------------------------------------------------


'--------------------------------------------------------------
'Creates a workbook and a worksheet and assigns them to their
'respective variables
Set objBook = objApp.Workbooks.Add
Set objSheet = objBook.Worksheets(1)
'--------------------------------------------------------------


'--------------------------------------------------------------
'Counts the number of combo boxes with data in them, then
'creates an array of that size.
For Each xCtrl In Me.Controls
    strVarString = xCtrl.Properties("Name")
    If Left(strVarString, 6) = "cmbCol" And Not (IsNull(xCtrl)) Then
        xColCount = xColCount + 1
    End If
Next xCtrl
'
'Terminate code if the user did not select any columns
If xColCount = 0 Then
    strVarString = "You did not select any data to be exported."
    MsgBox strVarString
    GoTo Cleanup
    xShowMessage = False
Else
    xShowMessage = True
End If
'
        ReDim xExportArray(xColCount, 1)
'
'Assigns the values in the combo boxes to their respective
'positions in the array.
For Each xCtrl In Me.Controls
    strVarString = xCtrl.Properties("Name")
    If Left(strVarString, 6) = "cmbCol" And Not (IsNull(xCtrl)) Then
        i = i + 1
        xExportArray(i, 1) = CStr(xCtrl)
    End If
Next xCtrl
'--------------------------------------------------------------


'--------------------------------------------------------------
'Create SQL statement to use to query data from Customers table.
strSQL = "SELECT "
For i = 1 To UBound(xExportArray)
    strSQL = strSQL & "Customers.[" & xExportArray(i, 1) & "], "
Next i
strSQL = Left(strSQL, Len(strSQL) - 2)
strSQL = strSQL & " FROM Customers;"
'
'Create recordset using the SQL statement
Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot)
'--------------------------------------------------------------


'--------------------------------------------------------------
'Create column headers in excel worksheet
For i = 1 To UBound(xExportArray)
    objSheet.Cells(1, i) = xExportArray(i, 1)
Next i
'
'Fill excel worksheet worksheet with Customers Table data
rs.MoveFirst
c = 1
Do Until rs.EOF
    c = c + 1
    For i = 0 To rs.Fields.Count - 1
        objSheet.Cells(c, i + 1) = rs.Fields(i)
    Next i
    objSheet.Cells(c, 1).RowHeight = 12.75
    rs.MoveNext
Loop
'
'Save excel workbook
strVarString = CurrentProject.Path & "\Exported.xls"
objApp.DisplayAlerts = False
objBook.SaveAs (strVarString)
objApp.DisplayAlerts = True
objBook.Close
xShowError = False
'--------------------------------------------------------------


'--------------------------------------------------------------
Cleanup:
'Notify user of the location of the exported data
If xShowMessage Then
    strVarString = "Your data has been exported to " & CurrentProject.Path & "\Exported.xls"
    MsgBox strVarString
Else
    objApp.DisplayAlerts = False
    objBook.Close
    objApp.DisplayAlerts = True
End If
'
'Clean object variables
Set objApp = Nothing
Set objBook = Nothing
Set objSheet = Nothing
Set db = Nothing
Set rs = Nothing
'
'Close the Exports form without saving
objApp.DisplayAlerts = False
DoCmd.Close acForm, "Exports", acSaveNo
objApp.DisplayAlerts = True
'--------------------------------------------------------------


End Sub

Any ideas?

Also, if I don't error trap and the program fails, it gives the "Application defined or Object Defined Error" message and highlights this line:

objSheet.Cells(c, i + 1) = rs.Fields(i)

 

[llkhoutx]

The data validation property of the offending Excel column needs to be adjusted.

 

[Radioactiveduck]

The excel file is being created from scratch within VBA, so I don't see how any of the excel columns could be limited by data validation. Could you be more specific?

 

[georgedwilkinson]

This is a known "issue", except the 1000 bytes problem. If you are using Office 2003 or earlier, the limit is 255 bytes.

I had to write a special function to concatenate the data and write it to Excel. It has been a while but there are several "recommendations" on how to deal with this.

But then, I don't even know if you are under the same scenario (version, database layout, queries, transfer command, etc.).

 

[Radioactiveduck]

I am using Access and Excel 2003, as a matter of fact. And that solution worked. I wrote a function that broke the field down into text strings of 900 characters or less and concatenated them into a variable. Then setting the excel cell equal to the string variable did the trick. For anyone else with this issue:

Do Until rs.EOF
    c = c + 1
    k = 0
    strVarString = ""
    For i = 0 To rs.Fields.Count - 1
        If Len(rs.Fields(i)) > 900 Then
            xCharCount = Len(rs.Fields(i))
                Do
                    If xCharCount <= 900 Then
                        strVarString = strVarString & Right(rs.Fields(i), xCharCount)
                        Exit Do
                    Else
                        strVarString = strVarString & Mid(rs.Fields(i), (900 * k) + 1, 900)
                        k = k + 1
                        xCharCount = xCharCount - 900
                    End If
                Loop
                objSheet.Cells(c, i + 1) = strVarString
        Else
            objSheet.Cells(c, i + 1) = rs.Fields(i)
        End If
    Next i
    objSheet.Cells(c, 1).RowHeight = 12.75
    rs.MoveNext
Loop

I'm not sure if it was even necessary to parse it into 900 character strings, come to think of it. It may have worked just to pass the rs.field(i) value directly into the string variable.

 

[georgedwilkinson]

Great! Thanks for posting your solution. This comes up about every 2 or 3 months.

 

[llkhoutx]

It's not necessary to parse the column.