Update long memo field in tables via VBA

[thewesties]

Could somebody please help me before I dump a gallon of water on my pc!

I am very happy to have come across this site on the internet. TheScripts has helped me through so many issues to this point. I have now spent the last 2 days scouring the net for a resolution to my problem.

I have a DB with MANY tables, but a transfer of 1 memo field between 2 in particular (tbl_Proposal to tbl_Job) is where my problem is. Nothing is working. The field is a proposal which can have next to nothing up to several pages (including carriage returns).

I have left out all the code around this that I know works. The database has been in effect for several years, but is in the process of a major enhancement so there have been no issues with any of the existing globals (g_variable).

Any items that are a global (g_*) are functioning properly. They are passing the proper values in the proper formats.


Here is a snippet of feeble attempt number 1:

[tt]
g_NewJob = True ' Flag to control a caption in the form popup_Date
DoCmd.OpenForm "popup_Date", acNormal, , , , acDialog

If IsNull(g_Accepted_Date) Then
Exit Sub
End If

If Trim(g_Accepted_Date & "x") = "x" Then
' User entered a blank or hit cancel
DoCmd.SetWarnings True
Exit Sub
End If

'With Bid Description 2
DoCmd.RunSQL ("INSERT INTO tbl_Job (Job_Number, CustomerID, ContactID, ProposalID, Proposal_Date, Proposal_Revision_Number, Job_Scope_Of_Work, Job_Name, Job_Address, Job_City, Job_State, Job_Brief_Description, Job_Accepted_Date, Job_Pictures_Directory, Job_Excel_Link ) " & _
"VALUES('" & g_JobNumber & "', " & Me.CustomerID & ", " & Me.ContactID & ", " & Me.ProposalID & ", #" & Me.Proposal_Date & "#, '" & Me.Prop_Revision_Number & "', '" & Me.Bid_Description2 & "', '" & Me.Job_Name & "', '" & Me.Job_Address & "', '" & Me.Job_City & "', '" & Me.Job_State & "', '" & Me.Job_Brief_Description & "', #" & g_Accepted_Date & "#, '" & Me.Pictures_Directory & "', '" & Me.Excel_Link & "')")
[/tt]


THIS RESULTED IN
Run-time error '3075':

So, I came to the conclusion that because some of these memo fields (Bid_Description2) can be large, Access is having a serious issue with passing text of that size in a single query.

Next, I found a solution that recommended parsing the data using an array. I used the carriage returns as a delimeter to parse the memo in to smaller chunks (fingers crossed).

Feeble attempt number 2

[tt]
'Without Bid Description 2
DoCmd.RunSQL ("INSERT INTO tbl_Job ( Job_Number, CustomerID, ContactID, ProposalID, Proposal_Date, Proposal_Revision_Number, Job_Name, Job_Address, Job_City, Job_State, Job_Brief_Description, Job_Accepted_Date, Job_Pictures_Directory, Job_Excel_Link ) " & _
"VALUES('" & g_JobNumber & "', " & Me.CustomerID & ", " & Me.ContactID & ", " & Me.ProposalID & ", #" & Me.Proposal_Date & "#, '" & Me.Prop_Revision_Number & "', '" & Me.Job_Name & "', '" & Me.Job_Address & "', '" & Me.Job_City & "', '" & Me.Job_State & "', '" & Me.Job_Brief_Description & "', #" & g_Accepted_Date & "#, '" & Me.Pictures_Directory & "', '" & Me.Excel_Link & "')")

Dim myString
Dim x As Integer
Dim myArray() As String

g_SQLStmt1 = "SELECT tbl_Proposal.Bid_Description2 FROM tbl_Proposal WHERE (((tbl_Proposal.ProposalID)=" & Me.ProposalID & "));"

Set g_myRS1 = g_myDB.OpenRecordset(g_SQLStmt1)
With g_myRS1
If .EOF And .BOF Then
MsgBox "No Scope of Work present"
GoTo LetsMOveOn
Else
myString = g_myRS1("Bid_Description2")
End If
End With
g_myRS1.Close


myArray = Split(myString, Chr(13) & Chr(10), -1, 1)

For x = LBound(myArray) To UBound(myArray)
DoCmd.RunSQL ("UPDATE tbl_Job SET tbl_Job.Job_Scope_Of_Work = [tbl_Job]![Job_Scope_Of_Work] & '" & myArray(x) & vbCrLf & "' WHERE (((tbl_Job.Job_Number)='" & g_JobNumber & "'));")
' Somewhere in here it died
Next x
[/tt]


This was working sweet UNTIL about half way through the line of text in the 9th element in the arrray when I received yeat another Run-time 3075 error. This was about 571 characters (including spaces and the CHR's). So, it's not based on the 256 character thing.

OK. Breath deep. Fingers no longer crossed, only one is now extended.
Let's try something else. Feeble attempt number 3

[tt]
'Without Bid Description 2
DoCmd.RunSQL ("INSERT INTO tbl_Job ( Job_Number, CustomerID, ContactID, ProposalID, Proposal_Date, Proposal_Revision_Number, Job_Name, Job_Address, Job_City, Job_State, Job_Brief_Description, Job_Accepted_Date, Job_Pictures_Directory, Job_Excel_Link ) " & _
"VALUES('" & g_JobNumber & "', " & Me.CustomerID & ", " & Me.ContactID & ", " & Me.ProposalID & ", #" & Me.Proposal_Date & "#, '" & Me.Prop_Revision_Number & "', '" & Me.Job_Name & "', '" & Me.Job_Address & "', '" & Me.Job_City & "', '" & Me.Job_State & "', '" & Me.Job_Brief_Description & "', #" & g_Accepted_Date & "#, '" & Me.Pictures_Directory & "', '" & Me.Excel_Link & "')")

g_SQLStmt1 = "SELECT tbl_Proposal.Bid_Description2 FROM tbl_Proposal WHERE (((tbl_Proposal.ProposalID)=" & Me.ProposalID & "));"

Dim sDriver As String
Dim workdb As Database
Dim worktable As DAO.TableDef
Dim workset As DAO.Recordset

Set workdb = CurrentDb
Set worktable = workdb.TableDefs("tbl_Job")
Set workset = worktable.OpenRecordset(dbOpenTable)

Set g_myRS1 = g_myDB.OpenRecordset(g_SQLStmt1)
With g_myRS1
If Not workset.EOF Then
sDriver = CStr(g_JobNumber)
workset.Index = "PrimaryKey"
workset.Seek "=", sDriver
If workset.NoMatch Then
MsgBox ("Entry not found")
Else
MsgBox ("Entry found")
End If
Else
MsgBox "No records."
End If

End With
g_myRS1.Close
[/tt]


Alas, a new run time error : 3219

Can anyone please help me? I am at my wit's end and I have a bottle of Poland Spring and I'm not afraid to use it...
Laughter is the only thig that keeps me going at this point.

Regards,
Westy Code:

 

[JoeAtWork]

When you quote error numbers, can you also quote the error description, as I think most of us have not memorized the error codes (although I know 13 is usually easy to fix).

Also, a bit more description on what your actual goal is. I think you want to take the data from a memo field, split it up and save it to several fields, but I do not understand what the rationale is for where the splits should be.

The easiest way I find to debug this sort of thing is to output the concatenated SQL string to the Immediate window, then copy & paste in a query window and try running it. Usually the problem becomes apparent.

 

[CaptainD]

Have you looked at the string to see if there are apostrophes'in the text.

If so they need to be changed to "''" (Two apostrophes)

Replace([tbl_Job]![Job_Scope_Of_Work],"'","''")