Query is missing out memo fields with more than 255 characters (Variation on a known

[derekbrown]

Hi,

I am having a problem with the attached code. I have a database with 2 main tables that are joined on a 1:Many relationship. The master table contains faults raised and the other table contains notes. There may be multiple notes per fault. What I want to do is be able to run a query that shows the fault and merges all of the notes for that fault into one continuos string of text. I managed to find some code that does this but my problem is that if any one of the note fields associated with a record has more than 255 characters the record is not exported to a table that is created to hold the fault and all of its concatenated notes. The note field's are all Memo fields and the field that they are being exported to is a Memo field so I'm not sure why this is happening. The code is shown below.

ReplaceStr and SQLFixup function are to replace unescaped quotes. Hijacked from Microsoft.

FixTable and CreateTables are the real workings of it all. CreateTables simply deletes the old table to hold the exported info and recreates it with the relevant field settings. FixTable is the workhorse which uses an SQL statement to insert values taken from the two main tables into the holding table. As well as this it concatenates the notes if the fault Reference (RefID) is the same.

I can post the database if required with some sample records to show the problem happening.

Option Compare Database
Option Explicit

_______________________________________________

Public Function ReplaceStr(TextIn, ByVal SearchStr As String, ByVal Replacement As String, _
ByVal CompMode As Integer)

Dim WorkText As String, Pointer As Integer

If IsNull(TextIn) Then

ReplaceStr = Null

Else

WorkText = TextIn
Pointer = InStr(1, WorkText, SearchStr, CompMode)

Do While Pointer > 0
WorkText = Left(WorkText, Pointer - 1) & Replacement & Mid(WorkText, Pointer + Len(SearchStr))
Pointer = InStr(Pointer + Len(Replacement), WorkText, SearchStr, CompMode)
Loop

ReplaceStr = WorkText

End If

End Function

_______________________________________________

Public Function SQLFixup(TextIn)

SQLFixup = ReplaceStr(TextIn, "'", "''", 0)

End Function

_______________________________________________

Public Function FixTable() As Boolean
On Error Resume Next

Dim db As DAO.Database, rs As DAO.Recordset, sSQL As String
'Dim strColumn1 As Long, strColumn2 As String

Dim strCol1 As Long 'RefID
Dim strCol2 As String 'Area
Dim strCol3 As String 'FullIssue (Issue Description & BuildRaised & VersionRaised)
Dim strCol4 As String 'Attachment
Dim strCol5 As String 'Priority
Dim strCol6 As Date 'DateRaised
Dim strCol7 As String 'FullNote (NoteType & NoteBy & NoteDate & Build & Version & Note
Dim strCol8 As String 'CurrentStatus

Set db = CurrentDb()
Call CreateTables(db)

sSQL = "SELECT tblIssue.RefID, Area, IssueDescription & ' [' & BuildRaised & ', ' & VersionRaised & ']' AS FullIssue, Attachment, Priority, DateRaised, '[' & NoteType & ', ' & NoteBy & ', ' & NoteDate & ', ' & Build & ', ' & Version & '] ' & Note AS FullNote, CurrentStatus" _
& " FROM tblIssue LEFT JOIN tblNotes ON tblIssue.RefID = tblNotes.RefID" _
& " ORDER BY tblIssue.RefID"

Set rs = db.OpenRecordset(sSQL, dbOpenSnapshot)

If Not rs.BOF And Not rs.EOF Then
rs.MoveFirst

strCol1 = rs!RefID
strCol2 = rs!Area
strCol3 = SQLFixup(rs!FullIssue)
strCol4 = rs!Attachment
strCol5 = rs!Priority
strCol6 = rs!DateRaised
strCol7 = SQLFixup(rs!FullNote)
strCol8 = rs!CurrentStatus

rs.MoveNext

Do Until rs.EOF
If strCol1 = rs!RefID Then
strCol7 = strCol7 & Chr(13) & rs!FullNote
Else
sSQL = "INSERT INTO tblExport (RefID, Area, FullIssue, Attachment, Priority, DateRaised, FullNote, CurrentStatus) VALUES('" & strCol1 & "','" & strCol2 & "','" & strCol3 & "','" & strCol4 & "','" & strCol5 & "','" & strCol6 & "','" & strCol7 & "','" & strCol8 & "')"
db.Execute sSQL
strCol1 = rs!RefID
strCol2 = rs!Area
strCol3 = SQLFixup(rs!FullIssue)
strCol4 = rs!Attachment
strCol5 = rs!Priority
strCol6 = rs!DateRaised
strCol7 = SQLFixup(rs!FullNote)
strCol8 = rs!CurrentStatus
End If

rs.MoveNext

Loop

' Insert Last Record

sSQL = "INSERT INTO tblExport (RefID, Area, FullIssue, Attachment, Priority, DateRaised, FullNote, CurrentStatus) VALUES('" & strCol1 & "','" & strCol2 & "','" & strCol3 & "','" & strCol4 & "','" & strCol5 & "','" & strCol6 & "','" & strCol7 & "','" & strCol8 & "')"
db.Execute sSQL
End If

Set rs = Nothing
Set db = Nothing

End Function

_______________________________________________

Private Function CreateTables(ByRef dbs As DAO.Database)

On Error Resume Next
Dim sSQL As String

' Delete Table, if exists
If DCount("*", "MsysObjects", "[Name]='tblExport'") = 1 Then
DoCmd.DeleteObject acTable, "tblExport"
End If

sSQL = "CREATE TABLE tblExport (RefID Long, Area Text, FullIssue Memo, Attachment Text, Priority Text, DateRaised DateTime, FullNote Memo, CurrentStatus Text)"
dbs.Execute sSQL

End Function

_______________________________________________

Hope someone can help with this problem as it is driving me up the wall!

Thanks in advance!

Derek