Need a larger data type than string

[kw_uh97]

I am concatenating an INSERT statement or an UPDATE statement within an If
Then Else End If statement. My string data type truncates the INSERT/UPDATE
statement and I need a larger data type to hold the INSERT/UPDATE statement.
Does anyone know how I can get this to handle more than 255 characters?

 

[Dirk Goldgar]

I am concatenating an INSERT statement or an UPDATE statement within an If
Then Else End If statement. My string data type truncates the
INSERT/UPDATE
statement and I need a larger data type to hold the INSERT/UPDATE
statement.
Does anyone know how I can get this to handle more than 255 characters?

The String data type in VBA is able to hold up to approximately 2 billion
characters, so I don't think that's the source of your problem. The Text
*field* type, in a table's design, is only able to hold 255 characters.
Could that be where your problem lies? If so, you can use the Memo type,
which is not so restricted.

Or it could be, I suppose, that you are managing to create a SQL statement
that is too long for the database engine to process. You'd need to post
your code so that we can see what's going on.

 

[John W. Vinson]

I am concatenating an INSERT statement or an UPDATE statement within an If
Then Else End If statement. My string data type truncates the INSERT/UPDATE
statement and I need a larger data type to hold the INSERT/UPDATE statement.
Does anyone know how I can get this to handle more than 255 characters?

Please post your code. A String variable in VBA is emphatically NOT limited to
255 characters; are you perhaps trying to store the data in a Text field in a
table? If so a Memo field will serve your needs better.

 

[Dymondjack]

Another alternative, besides using the Memo field, would be to write the
statement to a text file. Text files are relatively easy to manage for an
intermediate programmer and can hold much more data than a memo field, though
sorting the information is considerably more involved. Depending on how many
different strings you need to store, this may or may not be a good
alternative.

The only reason I bring this up, is because at some point (unfortunately I
don't recall where), I had read some discussion questioning the integrity of
the memo field and the possibility of phasing it out in future versions.
This may or may not be valid in the least bit, so hopefully I don't cause an
uproar by saying it. I really wish I at least remember where I had read it
so I could reference it here.

Perhaps someone with more experience could comment on this, I have never
used a memo field myself (based on the above paragraph).

Thereagain, chances are if an MVP is telling you that a Memo field will
work, who am I to argue?

Yet another possibility might be to store only the unique portions of the
statement to a table field (via a delimited string), and use a function to
parse the stored value and build the full statement. This could drastically
cut down on the size of data that might actually need to be stored, and would
be a more managable approach than a text file if you have many different
statements to use.

 

[kw_uh97]

Here is my code, I have shortened it a bit.

Sub UploadDocDwgs()
Dim SQL As String
Dim SQL2 As String
Dim SQL3 As String
Dim SQL4 As String * 500
Dim rsFiles As New ADODB.Recordset
Dim MyImportFolder As String
Dim vFilePath As String
Dim vFileSize As Long
Dim vRevisionRef As String
Dim vNewPrimKey As String
Dim MyMessage As String
Dim vError As String
Dim FileName As String
Dim Confidential As Integer
Dim Counter As Integer
Dim DocOrDwg As Integer


On Error GoTo ErrorHandling

FileName = afGetOpenFileName(Me.hwnd, , "Select a file from the download
folder.")
If Nz(FileName, "") = "" Then Exit Sub
MyImportFolder = afGetBaseFilepath(FileName)
'MyImportFolder = InputBox("Input folder to import from", "Bulk Copy",
"c:\DocDwgImport")

DoCmd.Hourglass True

SQL = "SELECT * "
SQL = SQL & " FROM atbv_DocCtrl_BulkCopy WHERE CreatedBy = SUSER_SNAME()
ORDER BY DocDwgID"

rsFiles.Open SQL, CurrentProject.Connection, adOpenDynamic,
adLockOptimistic

If Nz(MyImportFolder) = "" Then
GoTo ExitMe
'Else
'MyImportFolder = MyImportFolder & "\"
End If

Counter = 0

While Not rsFiles.EOF

vFilePath = MyImportFolder & rsFiles("FileName")
If Nz(Dir(vFilePath, vbNormal)) = "" Then
MyMessage = MyMessage & rsFiles("FileName") & vbCrLf
End If

rsFiles.MoveNext
Wend

If Nz(MyMessage) <> "" Then
MsgBox "File(s) " & MyMessage & " was(were) not located in the
selected folder.", vbOKOnly, "File(s) Not Found"
GoTo ExitMe
End If

MyMessage = ""

rsFiles.MoveFirst

While Not rsFiles.EOF
If Nz(rsFiles("DocDwgID")) = "" Then
MyMessage = "Records exist that don't have a document ID. Those
records cannot be loaded."
GoTo ExitMe
End If

rsFiles.MoveNext
Wend

MyMessage = ""

rsFiles.MoveFirst

While Not rsFiles.EOF

'Check for Existing DocDwgID
If IsNull(afDLookup("[DocDwgID]", "atbv_DocCtrl_DocDwgs",
"[DocDwgID]='" & rsFiles("DocDwgID") & "'")) Then
MyMessage = MyMessage & "Inserted " & rsFiles("DocDwgID") &
" as New DocDwg ID" & vbCrLf
If Nz(rsFiles("ConfidentialityGroup"), "") = "" Then
Confidential = 0
Else
Confidential = 1
End If

If Nz(rsFiles("DocOrDwg"), "") = "DWG" Then
DocOrDwg = 0
Else
DocOrDwg = 1
End If

SQL = "INSERT INTO atbv_DocCtrl_DocDwgs (DocDwgID,
AltDocDwgID, Title, Originator, ContrCompany, CurrentRev, "
SQL = SQL & " CurrentRevDate, CurrentStep, EquipmentTagNo,
VendorPONo, "
SQL = SQL & " Facility, System, Discipline, DocType,
Confidential, ConfidentialityGroup, DocOrDwg)"
SQL = SQL & " SELECT '" & rsFiles("DocDwgID") & "', '" &
rsFiles("AltDocDwgID") & "',"
SQL = SQL & " '" & rsFiles("Title") & "', '" &
rsFiles("Originator") & "', '" & rsFiles("Company") & "', "
SQL = SQL & " '" & rsFiles("Rev") & "', "
SQL = SQL & " '" & afDate(rsFiles("RevDate")) & "', "
SQL = SQL & " LEFT('" & rsFiles("Step") & "',10), "
SQL = SQL & " '" & rsFiles("EquipmentNo") & "', "
SQL = SQL & " '" & rsFiles("PONo") & "', "
SQL = SQL & " '" & rsFiles("Facility") & "', "
SQL = SQL & " '" & rsFiles("System") & "', "
SQL = SQL & " '" & rsFiles("Discipline") & "', "
SQL = SQL & " '" & rsFiles("DocType") & "', "
SQL = SQL & " CAST(" & Confidential & "AS BIT), CAST(" &
DocOrDwg & "AS BIT), " & rsFiles("ConfidentialityGroup")
SQL = SQL & " CAST(" & DocOrDwg & "AS BIT)"

afExecute SQL, True, True
Else
MyMessage = MyMessage & "Updated " & rsFiles("DocDwgID") & "
DocDwg ID" & vbCrLf

SQL = "UPDATE atbv_DocCtrl_DocDwgs SET "
SQL = SQL & " Title = '" & rsFiles("Title") & "', "
SQL = SQL & " CurrentRev = '" & rsFiles("Rev") & "', "
SQL = SQL & " CurrentRevDate = '" &
afDate(rsFiles("RevDate")) & "', "
SQL = SQL & " CurrentStep = LEFT('" & rsFiles("Step") &
"',10), "
SQL = SQL & " IsDistributed = 0, RegulatoryStatus = 'Review'"
SQL = SQL & " DocOrDwg = " & DocOrDwg & " "
SQL = SQL & " WHERE DocDwgID = '" & rsFiles("DocDwgID") & "'"

afExecute SQL, True, True
End If




'Exit the Sub
ExitMe:
If rsFiles.State = adStateOpen Then rsFiles.Close
Set rsFiles = Nothing
DoCmd.Hourglass False
If Nz(MyMessage) = "" Then
MyMessage = "No files have been uploaded."
End If
MsgBox (MyMessage)
Exit Sub

'General error handling code
ErrorHandling:
Select Case Err

'--- Add Case statements for error between these lines ---
Case Else
If afErrorHandler = True Then
Resume 0
ElseIf afc("afTrapErr") Then
Stop
Resume 0
End If

End Select
Resume ExitMe

End Sub

Thanks In Advance For Any Feedback

 

[kw_uh97]

sorry correction: This should be in the update statement

SQL = SQL & " IsDistributed = 0, RegulatoryStatus = 'Review', "

insead of this:

SQL = SQL & " IsDistributed = 0, RegulatoryStatus = 'Review'"

Here is my code, I have shortened it a bit.

Sub UploadDocDwgs()
Dim SQL As String
Dim SQL2 As String
Dim SQL3 As String
Dim SQL4 As String * 500
Dim rsFiles As New ADODB.Recordset
Dim MyImportFolder As String
Dim vFilePath As String
Dim vFileSize As Long
Dim vRevisionRef As String
Dim vNewPrimKey As String
Dim MyMessage As String
Dim vError As String
Dim FileName As String
Dim Confidential As Integer
Dim Counter As Integer
Dim DocOrDwg As Integer


On Error GoTo ErrorHandling

FileName = afGetOpenFileName(Me.hwnd, , "Select a file from the download
folder.")
If Nz(FileName, "") = "" Then Exit Sub
MyImportFolder = afGetBaseFilepath(FileName)
'MyImportFolder = InputBox("Input folder to import from", "Bulk Copy",
"c:\DocDwgImport")

DoCmd.Hourglass True

SQL = "SELECT * "
SQL = SQL & " FROM atbv_DocCtrl_BulkCopy WHERE CreatedBy = SUSER_SNAME()
ORDER BY DocDwgID"

rsFiles.Open SQL, CurrentProject.Connection, adOpenDynamic,
adLockOptimistic

If Nz(MyImportFolder) = "" Then
GoTo ExitMe
'Else
'MyImportFolder = MyImportFolder & "\"
End If

Counter = 0

While Not rsFiles.EOF

vFilePath = MyImportFolder & rsFiles("FileName")
If Nz(Dir(vFilePath, vbNormal)) = "" Then
MyMessage = MyMessage & rsFiles("FileName") & vbCrLf
End If

rsFiles.MoveNext
Wend

If Nz(MyMessage) <> "" Then
MsgBox "File(s) " & MyMessage & " was(were) not located in the
selected folder.", vbOKOnly, "File(s) Not Found"
GoTo ExitMe
End If

MyMessage = ""

rsFiles.MoveFirst

While Not rsFiles.EOF
If Nz(rsFiles("DocDwgID")) = "" Then
MyMessage = "Records exist that don't have a document ID. Those
records cannot be loaded."
GoTo ExitMe
End If

rsFiles.MoveNext
Wend

MyMessage = ""

rsFiles.MoveFirst

While Not rsFiles.EOF

'Check for Existing DocDwgID
If IsNull(afDLookup("[DocDwgID]", "atbv_DocCtrl_DocDwgs",
"[DocDwgID]='" & rsFiles("DocDwgID") & "'")) Then
MyMessage = MyMessage & "Inserted " & rsFiles("DocDwgID") &
" as New DocDwg ID" & vbCrLf
If Nz(rsFiles("ConfidentialityGroup"), "") = "" Then
Confidential = 0
Else
Confidential = 1
End If

If Nz(rsFiles("DocOrDwg"), "") = "DWG" Then
DocOrDwg = 0
Else
DocOrDwg = 1
End If

SQL = "INSERT INTO atbv_DocCtrl_DocDwgs (DocDwgID,
AltDocDwgID, Title, Originator, ContrCompany, CurrentRev, "
SQL = SQL & " CurrentRevDate, CurrentStep, EquipmentTagNo,
VendorPONo, "
SQL = SQL & " Facility, System, Discipline, DocType,
Confidential, ConfidentialityGroup, DocOrDwg)"
SQL = SQL & " SELECT '" & rsFiles("DocDwgID") & "', '" &
rsFiles("AltDocDwgID") & "',"
SQL = SQL & " '" & rsFiles("Title") & "', '" &
rsFiles("Originator") & "', '" & rsFiles("Company") & "', "
SQL = SQL & " '" & rsFiles("Rev") & "', "
SQL = SQL & " '" & afDate(rsFiles("RevDate")) & "', "
SQL = SQL & " LEFT('" & rsFiles("Step") & "',10), "
SQL = SQL & " '" & rsFiles("EquipmentNo") & "', "
SQL = SQL & " '" & rsFiles("PONo") & "', "
SQL = SQL & " '" & rsFiles("Facility") & "', "
SQL = SQL & " '" & rsFiles("System") & "', "
SQL = SQL & " '" & rsFiles("Discipline") & "', "
SQL = SQL & " '" & rsFiles("DocType") & "', "
SQL = SQL & " CAST(" & Confidential & "AS BIT), CAST(" &
DocOrDwg & "AS BIT), " & rsFiles("ConfidentialityGroup")
SQL = SQL & " CAST(" & DocOrDwg & "AS BIT)"

afExecute SQL, True, True
Else
MyMessage = MyMessage & "Updated " & rsFiles("DocDwgID") & "
DocDwg ID" & vbCrLf

SQL = "UPDATE atbv_DocCtrl_DocDwgs SET "
SQL = SQL & " Title = '" & rsFiles("Title") & "', "
SQL = SQL & " CurrentRev = '" & rsFiles("Rev") & "', "
SQL = SQL & " CurrentRevDate = '" &
afDate(rsFiles("RevDate")) & "', "
SQL = SQL & " CurrentStep = LEFT('" & rsFiles("Step") &
"',10), "
SQL = SQL & " IsDistributed = 0, RegulatoryStatus = 'Review'"
SQL = SQL & " DocOrDwg = " & DocOrDwg & " "
SQL = SQL & " WHERE DocDwgID = '" & rsFiles("DocDwgID") & "'"

afExecute SQL, True, True
End If




'Exit the Sub
ExitMe:
If rsFiles.State = adStateOpen Then rsFiles.Close
Set rsFiles = Nothing
DoCmd.Hourglass False
If Nz(MyMessage) = "" Then
MyMessage = "No files have been uploaded."
End If
MsgBox (MyMessage)
Exit Sub

'General error handling code
ErrorHandling:
Select Case Err

'--- Add Case statements for error between these lines ---
Case Else
If afErrorHandler = True Then
Resume 0
ElseIf afc("afTrapErr") Then
Stop
Resume 0
End If

End Select
Resume ExitMe

End Sub

Thanks In Advance For Any Feedback

The String data type in VBA is able to hold up to approximately 2 billion
characters, so I don't think that's the source of your problem. The Text
*field* type, in a table's design, is only able to hold 255 characters.
Could that be where your problem lies? If so, you can use the Memo type,
which is not so restricted.

Or it could be, I suppose, that you are managing to create a SQL statement
that is too long for the database engine to process. You'd need to post
your code so that we can see what's going on.

--
Dirk Goldgar, MS Access MVP
www.datagnostics.com

(please reply to the newsgroup)

 

[Dirk Goldgar]

Here is my code, I have shortened it a bit.

Sub UploadDocDwgs()
Dim SQL As String
Dim SQL2 As String
Dim SQL3 As String
Dim SQL4 As String * 500
Dim rsFiles As New ADODB.Recordset
Dim MyImportFolder As String
Dim vFilePath As String
Dim vFileSize As Long
Dim vRevisionRef As String
Dim vNewPrimKey As String
Dim MyMessage As String
Dim vError As String
Dim FileName As String
Dim Confidential As Integer
Dim Counter As Integer
Dim DocOrDwg As Integer


On Error GoTo ErrorHandling

FileName = afGetOpenFileName(Me.hwnd, , "Select a file from the
download
folder.")
If Nz(FileName, "") = "" Then Exit Sub
MyImportFolder = afGetBaseFilepath(FileName)
'MyImportFolder = InputBox("Input folder to import from", "Bulk Copy",
"c:\DocDwgImport")

DoCmd.Hourglass True

SQL = "SELECT * "
SQL = SQL & " FROM atbv_DocCtrl_BulkCopy WHERE CreatedBy =
SUSER_SNAME()
ORDER BY DocDwgID"

rsFiles.Open SQL, CurrentProject.Connection, adOpenDynamic,
adLockOptimistic

If Nz(MyImportFolder) = "" Then
GoTo ExitMe
'Else
'MyImportFolder = MyImportFolder & "\"
End If

Counter = 0

While Not rsFiles.EOF

vFilePath = MyImportFolder & rsFiles("FileName")
If Nz(Dir(vFilePath, vbNormal)) = "" Then
MyMessage = MyMessage & rsFiles("FileName") & vbCrLf
End If

rsFiles.MoveNext
Wend

If Nz(MyMessage) <> "" Then
MsgBox "File(s) " & MyMessage & " was(were) not located in the
selected folder.", vbOKOnly, "File(s) Not Found"
GoTo ExitMe
End If

MyMessage = ""

rsFiles.MoveFirst

While Not rsFiles.EOF
If Nz(rsFiles("DocDwgID")) = "" Then
MyMessage = "Records exist that don't have a document ID.
Those
records cannot be loaded."
GoTo ExitMe
End If

rsFiles.MoveNext
Wend

MyMessage = ""

rsFiles.MoveFirst

While Not rsFiles.EOF

'Check for Existing DocDwgID
If IsNull(afDLookup("[DocDwgID]", "atbv_DocCtrl_DocDwgs",
"[DocDwgID]='" & rsFiles("DocDwgID") & "'")) Then
MyMessage = MyMessage & "Inserted " & rsFiles("DocDwgID") &
" as New DocDwg ID" & vbCrLf
If Nz(rsFiles("ConfidentialityGroup"), "") = "" Then
Confidential = 0
Else
Confidential = 1
End If

If Nz(rsFiles("DocOrDwg"), "") = "DWG" Then
DocOrDwg = 0
Else
DocOrDwg = 1
End If

SQL = "INSERT INTO atbv_DocCtrl_DocDwgs (DocDwgID,
AltDocDwgID, Title, Originator, ContrCompany, CurrentRev, "
SQL = SQL & " CurrentRevDate, CurrentStep, EquipmentTagNo,
VendorPONo, "
SQL = SQL & " Facility, System, Discipline, DocType,
Confidential, ConfidentialityGroup, DocOrDwg)"
SQL = SQL & " SELECT '" & rsFiles("DocDwgID") & "', '" &
rsFiles("AltDocDwgID") & "',"
SQL = SQL & " '" & rsFiles("Title") & "', '" &
rsFiles("Originator") & "', '" & rsFiles("Company") & "', "
SQL = SQL & " '" & rsFiles("Rev") & "', "
SQL = SQL & " '" & afDate(rsFiles("RevDate")) & "', "
SQL = SQL & " LEFT('" & rsFiles("Step") & "',10), "
SQL = SQL & " '" & rsFiles("EquipmentNo") & "', "
SQL = SQL & " '" & rsFiles("PONo") & "', "
SQL = SQL & " '" & rsFiles("Facility") & "', "
SQL = SQL & " '" & rsFiles("System") & "', "
SQL = SQL & " '" & rsFiles("Discipline") & "', "
SQL = SQL & " '" & rsFiles("DocType") & "', "
SQL = SQL & " CAST(" & Confidential & "AS BIT), CAST(" &
DocOrDwg & "AS BIT), " & rsFiles("ConfidentialityGroup")
SQL = SQL & " CAST(" & DocOrDwg & "AS BIT)"

afExecute SQL, True, True
Else
MyMessage = MyMessage & "Updated " & rsFiles("DocDwgID") &
"
DocDwg ID" & vbCrLf

SQL = "UPDATE atbv_DocCtrl_DocDwgs SET "
SQL = SQL & " Title = '" & rsFiles("Title") & "', "
SQL = SQL & " CurrentRev = '" & rsFiles("Rev") & "', "
SQL = SQL & " CurrentRevDate = '" &
afDate(rsFiles("RevDate")) & "', "
SQL = SQL & " CurrentStep = LEFT('" & rsFiles("Step") &
"',10), "
SQL = SQL & " IsDistributed = 0, RegulatoryStatus =
'Review'"
SQL = SQL & " DocOrDwg = " & DocOrDwg & " "
SQL = SQL & " WHERE DocDwgID = '" & rsFiles("DocDwgID") &
"'"

afExecute SQL, True, True
End If




'Exit the Sub
ExitMe:
If rsFiles.State = adStateOpen Then rsFiles.Close
Set rsFiles = Nothing
DoCmd.Hourglass False
If Nz(MyMessage) = "" Then
MyMessage = "No files have been uploaded."
End If
MsgBox (MyMessage)
Exit Sub

'General error handling code
ErrorHandling:
Select Case Err

'--- Add Case statements for error between these lines ---
Case Else
If afErrorHandler = True Then
Resume 0
ElseIf afc("afTrapErr") Then
Stop
Resume 0
End If

End Select
Resume ExitMe

End Sub

I guess that it's the last couple of assignments to the "SQL" variable that
appear to be truncated. I don't see any reason that they would be
truncated, in that code. Maybe it's something that's happening in the
"afExecute" procedure, which is not shown. You could insert a line

Debug.Print SQL

in the code, before calling afExecute, to have the current value of the SQL
variable displayed in the Immediate Window where you could check it. If
that looks wrong, I've overlooked something. If not, you'll need to examine
afExecute to see what's happening to the SQL string.