concatenation and max length of string in VBA, access - string
I've had severas problems with strings in access-vba.
The thing is, access (sometimes) limit the string's length to about 255 characters.
However, depending on HOW the string was built, it may be able to grow bigger then 255 chars.
There's an example of WORKING code :
Dim strReq as String
strReq = "SELECT exampleField1, exampleField2, exampleField3, exampleField4, exampleField5 "
strReq = strRec & ", exampleField6, exampleField7, exampleField8, .... [etc. insert many fields, you get it]"
strReq = strReq & " FROM myTable INNER JOIN Tbl2 ON ...[many JOINs as well]"
And so on, I often work with large queries so the 256 chars is easily busted.
However, these examples doesn't work :
Dim strReq as String
strReq = "SELECT exampleField1, exampleField2, exampleField3, exampleField4, exampleField5 " & _
", exampleField6, exampleField7, exampleField8, .... [etc. insert many fields, you get it]" & _
" WHERE exampleField1 = x AND exampleField2 = y AND exampleField3 = z" & _
" ORDER BY 1,2,3,4,5,6"
And this doesn't work either :
Dim strReq as String
Dim strWhere as String
strReq = "SELECT exampleField1, exampleField2, exampleField3, exampleField4, exampleField5 "
strReq = strRec & ", exampleField6, exampleField7, exampleField8, .... [etc. insert many fields, you get it]"
strWhere = "WHERE exampleField1 = x "
strWhere = strWhere & "AND exampleField2 = y"
strWhere= strWhere & " AND exampleField3 = z"
strReq = strReq & strWhere [& strJoin / strOrder / strHaving / etc]
I know know aproximatively how I can or cannot concatenate strings but I'd like to know how strings exactly work on access vba , because, i'll admit, it seems quite random so far...
*(Please note, these strings are supposed of longer length then the 255 characters AND the query is just there as an example, syntaxe mistakes or exact length in these are not the point here)
*Edit -- adding the code I'm actually using (With the working version, tried both bugging versions to clean up the code and both were bugging
strReq = "SELECT " & IIf(Len(rsRap.Fields("top")) > 0, " TOP " & rsRap.Fields("top"), "") & " " & rsRap.Fields("champs") & ", Sum([Canada]*[Quantité]) AS Montant, Sum(TblDetailCom.Quantité) AS Qty " & IIf(Len(rsRap.Fields("rep")) > 0, ", NickName", "")
strReq = strReq & " FROM (SELECT * FROM TblRepresentant WHERE RefRep not In(13,15,26,27,28)) AS TblRepresentant INNER JOIN "
strReq = strReq & " ((TblProduits LEFT JOIN TblTypBijoux ON TblProduits.Type = TblTypBijoux.IdTypBijoux) "
strReq = strReq & " INNER JOIN (TblCouleur INNER JOIN ((TblClients INNER JOIN ((TblComm LEFT JOIN RqMaxIdTrait ON TblComm.ID = RqMaxIdTrait.IdCommande) "
strReq = strReq & " LEFT JOIN TblTraitement ON RqMaxIdTrait.MaxOfIdTrait = TblTraitement.IdTrait) ON TblClients.ID = TblComm.RefClient) "
strReq = strReq & " INNER JOIN TblDetailCom ON TblComm.ID = TblDetailCom.RefCom) ON TblCouleur.ID = TblDetailCom.RefCoul) "
strReq = strReq & " ON TblProduits.IdMod = TblDetailCom.RefProd) ON TblRepresentant.RefRep = TblClients.RefRepre "
strReq = strReq & " WHERE (TblClients.RefRepre <> 5 OR (TblClients.RefRepre=5 AND TblClients.ID In (1210,219,189,578))) "
'(((TblProduits.Coll)=16) AND((TblComm.CoDatCom)>=#2011-01-01# And (TblComm.CoDatCom)<=#2014-01-01#) " 'Params Collection (16) DteDeb/fin
'strReq = strReq & " AND "
If Len(rsRap.Fields("type")) > 0 Then
strReq = strReq & " AND TblProduits.[Type] = " & rsRap.Fields("type")
End If
If Len(txtDe) > 0 Then
strReq = strReq & " AND TblTraitement.DtTrait >= #" & txtDe & "# "
End If
If Len(txtA) > 0 Then
strReq = strReq & " AND TblTraitement.DtTrait <= #" & txtA & "# "
End If
If Len(rsRap.Fields("pays")) > 0 Then
strReq = strReq & " AND TblClients.ClPaiePays = '" & rsRap.Fields("pays") & "' "
End If
If Len(rsRap.Fields("rep")) > 0 Then
strReq = strReq & " AND TblClients.RefRepre = " & rsRap.Fields("rep")
End If
If Len(rsRap.Fields("col")) > 0 Then
strReq = strReq & " AND TblProduits.Coll=" & rsRap.Fields("col")
End If
If Len(rsRap.Fields("group")) > 0 Then
strReq = strReq & " GROUP BY " & rsRap.Fields("group") & IIf(Len(rsRap.Fields("rep")) > 0, ", NickName", "")
End If
strReq = strReq & " HAVING Sum([Canada]*[Quantité]) >= 0 "
If Len(rsRap.Fields("order")) > 0 Then
strReq = strReq & " ORDER BY " & rsRap.Fields("order")
End If
You seem to accept the fact that a VBA string can contain more than 255 characters. As an example this code creates a 264 character string.
Const cstrSegment As String = "0123456789" & vbCrLf
Dim MyBigString As String
Dim i As Long
For i = 1 To 22
MyBigString = MyBigString & cstrSegment
Next
Debug.Print "Len(MyBigString): " & Len(MyBigString)
Rather you're encountering trouble based on the method you use to concatenate strings. I don't know where that trouble is exactly, but I can tell you there is a limit to the number of line continuations you can use when adding to a string. For example the following code compiles and runs without error. However if I add one more line continuation (& cstrSegment _), the compiler complains "Too many line continuations".
MyBigString = MyBigString & cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment _
& cstrSegment
If that describes the problem you're seeing, the limitation is based on line continuations, not string length. If needed, you could work around that limit by building the string in multiple steps. Do "MyBigString = MyBigString & cstrSegment _" up to the limit of line continuations, then add to MyBigString with another "MyBigString = MyBigString & cstrSegment _" block.
Make sure you're not misled by how many character you see. Perhaps the situation is you're only seeing the first 255 characters, but the string actually contains many more. That would make sense since you reported you're not getting an error building the string apparently fails.
Confirm the actual length of the string with Len():
Debug.Print "Len(MyBigString): " & Len(MyBigString)
You can also print the string's content to the Immediate window to see what it contains:
Debug.Print MyBigString
You can use Ctrl+g to open the Immediate window.
When concatenating strings for SQL, add a vbCrLf character when lines might grow long. Access seems to have trouble ingesting VBA strings (to execute as SQL) greater than about 1000 characters. e.g.
strSQL = strSQL & "SELECT some fields " & vbcrlf & "FROM some table "
Related
Excel VBA ADODB SQL connection doesn't run the whole execute command
Hey there I have a weird problem which I can't find its source. I have a messy code below which takes user input from one of the excel pages(kinda like a form) and creates a long sql query. Everytime SQLstrL command gets updated within the Do While it basically adds another INSERT command to the SQLstrL string. When I copy the sql query which VBA created via a function and paste on SSMS everything works like a charm. So I know there is nothing wrong with the command text. But when I try to execute from cn.Execute like below, It only executes first 4 INSERT commands of SQLstrL and ignores the rest. I have up to 60 INSERT commands within SQLstrL string. I have no idea why this bizarre problem occurs. If anyone can help me I'll be most appreciated. SQLStr = "DECLARE #newdatetime datetime; " & _ "DECLARE #newdatetimelong datetime; " & _ "DECLARE #timeint int; " & _ "DECLARE #newficheno varchar(17); " & _ "DECLARE #newlogref int; " & _ "SET #newficheno=(SELECT REPLICATE('0',LEN(LASTASGND)-LEN(LASTASGND+1))+REPLACE(STR(CONVERT(varchar,LASTASGND)+1),' ','') FROM L_LDOCNUM WHERE FIRMID=500 AND APPMODULE=1 AND DOCIDEN=12); " & _ "UPDATE L_LDOCNUM SET LASTASGND=#newficheno FROM L_LDOCNUM WHERE FIRMID=500 AND APPMODULE=1 AND DOCIDEN=12; " & _ "SET #newdatetime=CONVERT(datetime,'" & DateInp & "',104); " & _ "SET #timeint=LOGODB.dbo.LG_TIMETOINT(DATEPART(hour,GETDATE()),DATEPART(minute,GETDATE()),DATEPART(second,GETDATE())); " & _ "SET #newdatetimelong=#newdatetime+LOGODB.dbo.LG_INTTOTIME(#timeint); " & _ "INSERT INTO LG_500_01_STFICHE " & _ "SELECT 3,12,3, " & _ "#newficheno, " & _ "#newdatetime, " & _ "#timeint, " & _ "'','','','',0,0,0,0,0,0,'',0, " & _ "0,/*SOURCEINDEX*/ " & _ "0,0,0,/*SOURCECSTGRP*/ " & _ "0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,'','','','','','',1,0,0,0,0,0,0,1,#newdatetimelong,DATEPART(hour,#newdatetimelong),DATEPART(minute,#newdatetimelong),DATEPART(second,#newdatetimelong),0,NULL,0,0,0,0,0,'','','',/*TRACKNR*/ " & _ "3,0,'',0,0,1,0,0,0,0,0,0,'" & Worksheets("Form").Range("M1").Text & "',/*DOCTRACKINGNR*/ " & _ "0,0,'',0,0,0,'',0,'',0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,NULL,0,#newdatetime,#timeint,0,0,0,NEWID(),'',0,0,0,'',0,0,0,0,0,0,NULL,0,0,0,#newdatetime,#timeint, " & _ "0,0,'',0,'','',NULL,0,0,0,'','','','',0,0,'',0,NULL,0,NULL,0,0,0,0,0,0; " & _ "SET #newlogref=(SELECT LOGICALREF FROM LG_500_01_STFICHE WHERE TRCODE=12 AND FICHENO=#newficheno);" Startsearch = Worksheets("Form").Range("A3").Address Do While IsNumeric(Worksheets("Form").Range(Startsearch).Value) And Worksheets("Form").Range(Startsearch).Value <> "" SQLStrL = SQLStrL & " INSERT INTO LG_500_01_STLINE " & _ " SELECT " & _ CDbl(Application.VLookup(Worksheets("Form").Range(Startsearch).Offset(0, 1).Text, Worksheets("Destek").ListObjects("Malzemeler").Range.Offset(0, 2), 5, False)) & "," & _ " 0,0,0,0,12,#newdatetime,#timeint,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4,#newlogref, " & _ CDbl(Worksheets("Form").Range(Startsearch).Value) & "," & _ " 0,0,0,0,0,0,0,406,0,0,0,0,0,0,0,'','', " & _ Replace(CDbl(Worksheets("Form").Range(Startsearch).Offset(0, 12).Value), ",", ".") & "," & _ " 0,0,0,0,0,0,1,0,0,0,0,0,'" & Worksheets("Form").Range(Startsearch).Offset(0, 6).Text & "', " & _ CDbl(Application.VLookup(CDbl(Application.VLookup(Worksheets("Form").Range(Startsearch).Offset(0, 1).Text, Worksheets("Destek").ListObjects("Malzemeler").Range.Offset(0, 2), 4, 0)) & "-" & Worksheets("Form").Range(Startsearch).Offset(0, 13).Text, Worksheets("Destek").ListObjects("UnitSet").Range, 5, 0)) & "," & _ CDbl(Application.VLookup(Worksheets("Form").Range(Startsearch).Offset(0, 1).Text, Worksheets("Destek").ListObjects("Malzemeler").Range.Offset(0, 2), 4, False)) & "," & _ " 1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,'',0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,'','',0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, " & _ " DATEPART(month,#newdatetimelong),DATEPART(year,#newdatetimelong), " & _ " 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,NULL,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,'',0,0,NEWID(),'',0,0,'','',0,0,0,0,'',0,'','',0,0,'','',0,0,0,0,NULL,0,0,0,0,0,0,'','',0,0,0,0,0,0,NULL,0,0,0,0,0,0,0,0,0,'','','',NULL,0,0,0,0,0,0,0,0,0; " & vbNewLine Startsearch = Worksheets("Form").Range(Startsearch).Offset(1, 0).Address Loop Set cn = New ADODB.Connection cn.Open "Driver={SQL Server};Server=" & Server_Name & ";Database=" & Database_Name & _ ";Uid=" & User_ID & ";Pwd=" & Password & ";" cn.Execute SQLStr & SQLStrL, , ADODB.ExecuteOptionEnum.adExecuteNoRecords
Procedure to import excel file to access is erroring out after loop - MS Access Error 91: Object variable or With block variable not set
I'm getting an error message after the last loop runs in this procedure.The error is received after it cycles through the last worksheet in the excel workbook, and the line is "xl.ActiveSheet.Next.Select" (line 17 from the bottom). Can anyone give me a pointer? I've read and been told using .select is not ideal, but this is an older database I have inherited and would like to resolve this issue before improving the code. The loop opens up an excel file and cycles through each worksheet (24 in this workbook) and imports the data to an access database. I've searched this topic but many issues seem unrelated, or much simpler to debug. I've even removed all but two worksheets and the error is still repeatable. Any help is appreciated! Thanks! Private Sub lbl_WV_import_Click() If gcfHandleErrors Then On Error GoTo Err_frmMe_home_lbl_WV_import Dim xl As Object, wrkbk1 As Object Dim pcd As String, pcd_title As String, model As String, station As String, task As String, pic As String, bom_pn As String, c1 As String, c2 As String, spec As String, sApp As String Dim pn As String, pname As String, ts_part_name As String, ts_part_num As String, model_info As String, color As String, dest As String, tool As String, socket As String, torque As String, misc As String Dim rev As Integer, zone As Integer, seq As Integer, mod_id As Integer, delta As Integer, st_seq As Integer, qty As Integer, i As Integer, J As Integer, ts_sec As Integer, sec As Integer, row As Integer Dim pcd_id As LongPtr, stat_id As LongPtr, task_id As LongPtr, task_list_id As LongPtr, pn_id As LongPtr, tool_id As LongPtr, task_step_id As LongPtr Dim pitch As Double Set db = CurrentDb() sApp = "Excel.Application" If IsAppRunning(sApp) = True Then Set xl = GetObject(, "Excel.Application") For Each wrkbk1 In xl.Workbooks If wrkbk1.Name = "P1_PCD.xlsm" Then Exit For End If Next strSQL = DLookup("db_loc", "tbl_ext_source") & DLookup("area", "tblArea") & "\P1_PCD.xlsm" Set wrkbk1 = xl.Workbooks.Open(strSQL) Else Set xl = CreateObject("Excel.Application") xl.Application.Visible = True strSQL = DLookup("db_loc", "tbl_ext_source") & DLookup("area", "tblArea") & "\P1_PCD.xlsm" Set wrkbk1 = xl.Workbooks.Open(strSQL) End If xl.Workbooks("P1_PCD.xlsm").Activate xl.Sheets(1).Select xl.Range("B1").Select pcd_title = xl.Range("B1").Value xl.Range("O2").Select pitch = xl.Range("O2").Value xl.Range("Q2").Select pcd = "PCD-" & xl.Range("Q2").Value xl.Range("R2").Select rev = xl.Range("R2").Value xl.Range("K3").Select model = xl.Range("K3").Value If IsNull(DLookup("model", "tblModel", "[model] = '" & model & "'")) Then strSQL = "INSERT INTO tblModel (model) " _ & "Values ('" & model & "')" db.Execute strSQL lid = DMax("mod_id", "tblModel") strSQL = "INSERT INTO " _ & "tblAudit (EditDate, RecordSource, RecordID, User, Field, BeforeValue, AfterValue) " _ & "VALUES (Now(), ""tblModel"", '" & lid & "', '" & fosUserName() & "', ""model"", ""New Record"", '" & model & "')" db.Execute strSQL End If If IsNull(DLookup("pcd", "tblPCD", "pcd='" & pcd & "' AND rev=" & rev & "")) Then mod_id = DLookup("mod_id", "tblModel", "[model] = '" & model & "'") bom_pn = DLookup("ItemNo", "PYMAC", "LV = ""00""") strSQL = "INSERT INTO tblPCD ( pcd, pcd_title, rev, mod_id, pitch, pre_rev, bom_pn ) " _ & "VALUES ('" & pcd & "','" & pcd_title & "', " & rev & ", " & mod_id & ", " & pitch & ", " & rev - 1 & ", '" & bom_pn & "')" db.Execute strSQL pcd_id = DLookup("pcd_id", "tblPCD", "pcd='" & pcd & "' AND rev=" & rev & "") lid = DMax("pcd_id", "tblPCD") strSQL = "INSERT INTO " _ & "tblAudit (EditDate, RecordSource, RecordID, User, Field, BeforeValue, AfterValue) " _ & "VALUES (Now(), ""tblPCD"", '" & lid & "', '" & fosUserName() & "', ""ALL"", ""New Record"", ""New PCD from excel "" & " & pcd_id & ")" db.Execute strSQL Call upload_pymac(pcd_id) Set db = CurrentDb() Else If InputBox("This PCD already exists. Is this another section of this PCD that needs to be imported? [Y/N]") = "y" Then Else Exit Sub End If End If pcd_id = DLookup("pcd_id", "tblPCD", "pcd='" & pcd & "' AND rev=" & rev & "") If IsNull(DMax("seq", "tblTask", "[pcd_id] = " & pcd_id & "")) Then seq = 1 Else seq = DMax("seq", "tblTask", "[pcd_id] = " & pcd_id & "") End If For J = 1 To xl.ActiveWorkbook.Worksheets.Count xl.Range("O3").Select station = xl.Range("O3").Value If IsNull(DLookup("station", "tblStation", "[station] = '" & station & "'")) Then If IsNull(DMax("stat_id", "tblStation")) Then sec = 1 Else sec = DMax("stat_id", "tblStation") + 1 End If strSQL = "INSERT INTO tblStation ( station, zone_id,sec ) " _ & "VALUES ('" & station & "',1," & sec & ")" db.Execute strSQL lid = DMax("stat_id", "tblStation") strSQL = "INSERT INTO " _ & "tblAudit (EditDate, RecordSource, RecordID, User, Field, BeforeValue, AfterValue) " _ & "VALUES (Now(), ""tblStation"", '" & lid & "', '" & fosUserName() & "', ""ALL"", ""New Records"", ""New record for PCD "" & " & pcd_id & ")" db.Execute strSQL End If stat_id = DLookup("stat_id", "tblStation", "[station] = '" & station & "'") st_seq = 1 c1 = "C6" xl.Range(c1).Select Do Until xl.CountA(xl.ActiveCell) = 0 xl.Range(c1).Select task = xl.ActiveCell.Value If Len(task) > 250 Then task = Left(task, 255) End If If IsNull(DLookup("task_txt", "tblTask_txt", "[task_txt] = '" & task & "'")) Then strSQL = "INSERT INTO tblTask_txt ( task_txt ) " _ & "VALUES ('" & task & "')" db.Execute strSQL lid = DMax("task_list_id", "tblTask_txt") strSQL = "INSERT INTO " _ & "tblAudit (EditDate, RecordSource, RecordID, User, Field, BeforeValue, AfterValue) " _ & "VALUES (Now(), ""tblTask_txt"", '" & lid & "', '" & fosUserName() & "', ""task_txt"", ""New Record"", '" & task & "')" db.Execute strSQL End If task_list_id = DLookup("task_list_id", "tblTask_txt", "[task_txt] = '" & task & "'") xl.ActiveCell.Offset(0, 4).Select If xl.ActiveCell.Value = "Q" Then delta = 1 ElseIf xl.ActiveCell.Value = "C" Then delta = 2 ElseIf xl.ActiveCell.Value = "CTQ" Then delta = 3 ElseIf xl.ActiveCell.Value = "R" Then delta = 4 Else delta = 0 End If xl.ActiveCell.Offset(0, 1).Select spec = Replace(xl.ActiveCell.Value, "'", "''") If Len(spec) > 250 Then spec = Left(spec, 255) End If strSQL = "INSERT INTO tblTask ( pcd_id, seq, stat_id, task_list_id, st_seq, spec_inst ) " _ & "Values (" & pcd_id & ", " & seq & ", " & stat_id & ", " & task_list_id & "," & st_seq & ", '" & spec & "')" db.Execute strSQL task_id = DMax("task_id", "tblTask") lid = DMax("task_id", "tblTask") strSQL = "INSERT INTO " _ & "tblAudit (EditDate, RecordSource, RecordID, User, Field, BeforeValue, AfterValue) " _ & "VALUES (Now(), ""tblTask_txt"", '" & lid & "', '" & fosUserName() & "', ""ALL"", ""New Record"", ""New record for PCD "" & " & pcd_id & ")" db.Execute strSQL row = xl.ActiveCell.row() c2 = "E" & row xl.Range(c2).Select strSQL = DLookup("db_loc", "tbl_ext_source") & DLookup("area", "tblArea") & "\PICS\" & task_id & ".jpg" xl.Run "getpic", strSQL For i = 1 To 10 c2 = "K" & row & ":" & "T" & row If xl.CountA(xl.Range(c2)) = 0 Then Exit For End If c2 = "K" & row xl.Range(c2).Select c2 = xl.ActiveCell.Address ts_part_num = "" ts_part_name = "" pn = "" pname = "" pn_id = 0 tool = "" tool_id = 0 pname = xl.ActiveCell.Value If pname = "Part Name" Then Exit For End If xl.ActiveCell.Offset(0, 1).Select pn = xl.ActiveCell.Value If IsNull(DLookup("part_num", "tblPart_master", "[part_num] = '" & pn & "'")) Then ts_part_num = pn ts_part_name = pname Else pn_id = DLookup("pn_id", "tblPart_master", "[part_num] = '" & pn & "'") End If xl.ActiveCell.Offset(0, 1).Select qty = xl.ActiveCell.Value xl.ActiveCell.Offset(0, 1).Select model_info = xl.ActiveCell.Value xl.ActiveCell.Offset(0, 1).Select color = xl.ActiveCell.Value xl.ActiveCell.Offset(0, 1).Select dest = xl.ActiveCell.Value xl.ActiveCell.Offset(0, 1).Select tool = xl.ActiveCell.Value If Len(tool) > 1 Then If IsNull(DLookup("tool_id", "tblTools", "[tool] = '" & tool & "'")) Then strSQL = "INSERT INTO tblTools (tool, tool_type_id ) " _ & "Values ('" & tool & "',1)" db.Execute strSQL lid = DMax("tool_id", "tblTools") strSQL = "INSERT INTO " _ & "tblAudit (EditDate, RecordSource, RecordID, User, Field, BeforeValue, AfterValue) " _ & "VALUES (Now(), ""tblTools"", '" & lid & "', '" & fosUserName() & "', ""tool"", ""New Record"", '" & tool & "')" db.Execute strSQL End If tool_id = DLookup("tool_id", "tblTools", "[tool] = '" & tool & "'") End If xl.ActiveCell.Offset(0, 1).Select socket = xl.ActiveCell.Value xl.ActiveCell.Offset(0, 1).Select torque = xl.ActiveCell.Value xl.ActiveCell.Offset(0, 1).Select misc = xl.ActiveCell.Value strSQL = "INSERT INTO tblTask_steps ( task_id ) " _ & " Values ( " & task_id & " )" db.Execute strSQL task_step_id = DMax("task_step_id", "tblTask_steps") strSQL = "INSERT INTO " _ & "tblAudit (EditDate, RecordSource, RecordID, User, Field, BeforeValue, AfterValue) " _ & "VALUES (Now(), ""tblTask_steps"", '" & task_step_id & "', '" & fosUserName() & "', ""ALL"", ""New Record"", ""New record for PCD "" & " & pcd_id & ")" db.Execute strSQL strSQL = "SELECT tblTask_steps.* " _ & "FROM tblTask_steps " _ & "WHERE (((tblTask_steps.task_step_id)=" & task_step_id & "))" Set rs = db.OpenRecordset(strSQL) If Len(ts_part_name) > 0 Then rs.Edit rs!ts_part_name = ts_part_name rs.Update End If If Len(ts_part_num) > 0 Then rs.Edit rs!ts_part_num = ts_part_num rs.Update End If If pn_id > 0 Then rs.Edit rs!pn_id = pn_id rs.Update End If If qty > 0 Then rs.Edit rs!qty = qty rs.Update End If If Len(model_info) > 0 Then rs.Edit rs!model_info = model_info rs.Update End If If Len(color) > 0 Then rs.Edit rs!color = color rs.Update End If If Len(dest) > 0 Then rs.Edit rs!dest = dest rs.Update End If If tool_id > 0 Then rs.Edit rs!tool_id = tool_id rs.Update End If If Len(socket) > 0 Then rs.Edit rs!socket = socket rs.Update End If If Len(torque) > 0 Then rs.Edit rs!torque = torque rs.Update End If If delta > 0 Then rs.Edit rs!delta = delta rs.Update End If If Len(misc) > 0 Then rs.Edit rs!misc = misc rs.Update End If xl.Range(c2).Select xl.ActiveCell.Offset(1, 0).Select row = xl.ActiveCell.row() Next i ts_sec = 0 xl.Range(c1).Select xl.ActiveCell.Offset(1, 0).Select If xl.ActiveCell.Column() <> 3 Then row = xl.ActiveCell.row() c1 = "C" & row + 1 xl.Range(c1).Select End If If xl.ActiveCell.Value = "Task Description" Then xl.ActiveCell.Offset(1, 0).Select If xl.ActiveCell.Column() <> 3 Then row = xl.ActiveCell.row() c1 = "C" & row + 1 xl.Range(c1).Select End If End If If IsEmpty(xl.ActiveCell) Then strSQL = DLookup("db_loc", "tbl_ext_source") & DLookup("area", "tblArea") & "\PICS\" & task_id & "_2.jpg" xl.Run "getpic", strSQL xl.ActiveCell.Offset(1, 0).Select If xl.ActiveCell.Column() <> 3 Then row = xl.ActiveCell.row() c1 = "C" & row + 1 xl.Range(c1).Select End If End If If xl.ActiveCell.Value = "Task Description" Then xl.ActiveCell.Offset(1, 0).Select If xl.ActiveCell.Column() <> 3 Then row = xl.ActiveCell.row() c1 = "C" & row + 1 xl.Range(c1).Select End If End If c1 = xl.ActiveCell.Address st_seq = st_seq + 1 seq = seq + 1 Loop xl.ActiveSheet.Next.Select Next J xl.Application.ScreenUpdating = True strSQL = "UPDATE tblTask SET tblTask.image_id = [task_id] " _ & "WHERE (((tblTask.pcd_id)=" & pcd_id & "))" db.Execute strSQL Call recal_secs(1, pcd_id, 0) Call sort_stat_all(pcd_id) MsgBox "The PCD has been imported. Go to stations and assure the zones are correct." Set rs = Nothing Set db = Nothing Exit_frmMe_home_lbl_WV_import: Exit Sub Err_frmMe_home_lbl_WV_import: Call LogError(Err.Number, Err.Description, "frmMe_home_lbl_WV_import()") Resume Exit_frmMe_home_lbl_WV_import End Sub
As I tried suggesting in my above comment, it looks that the way you designed the code (probably, mostly based on macro recorder...), using an unjustified number of selecting, makes the code erroring on the respective line because of the fact that a Next sheet does not exist after the last one... If you want keeping the code as it is and only solve the error, please, try inserting above the problematic code line, the next one: If J = xl.ActiveWorkbook.Worksheets.Count Then Exit For But your code is not efficient, at all. The next part, for instance: xl.Workbooks("P1_PCD.xlsm").Activate xl.Sheets(1).Select xl.Range("B1").Select pcd_title = xl.Range("B1").value should be replaced with the more efficient one, not involving any Activation/selection: Dim ws As Object Set ws = xl.Workbooks("P1_PCD.xlsm") pcd_title = ws.Range("B1").value Then, the way of looping between the sheets is also not efficient. Activating the sheet and selecting any range to be used only consumes Excel resources. Instead of the way you use: For J = 1 To xl.ActiveWorkbook.Worksheets.Count you can do it in a different, more efficient way: Dim sh As Object For each sh in xl.ActiveWorkbook.Worksheets station = sh.Range("O3").Value 'your code... 'instead of 'xl.Range(c1).Select 'task = xl.ActiveCell.Value 'you should use: task = sh.Range(c1).Value ' or better task = sh.Range("C6").Value 'and eliminate c1 useless variable... 'it is at least strange to use 'c1 = "C" & row + 1 'xl.Range(c1).Select 'instead of directly: sh.Range("C" & row + 1) 'selection is useless, anyhow... Next sh Your code is too long, you do not explain in words what you want accomplishing and I cannot spend too much time to deduce what you try doing. I am only suggesting some things necessary to be changed in order to improve the code quality and speed...
VBA Adodb : concatenation of values
I would like to use in my query the key like this: '"prod.cd_produit"'||'"/"'||'" & strQ & "'. Here, the values of my variables are: prod.cd_produit= 53 and & strQ & =350, so I would like to have 53/350 as a key. I'm wondering if it's right to write '"prod.cd_produit"'||'"/"'||'" & strQ & "' (I don't want to have any spaces neither at right nor at left). This is a part of my code : Public Sub INFO_PROTO34(ByRef strQ As String) ........................................... " sousc.lp_etat_doss not in ('ANNUL','A30','IMPAY') and sousc.is_produit = prod.is_produit" & _ " and '"prod.cd_produit"'||'"/"'||'" & strQ & "' = proto.cd_protocole ", Thank you very much for your help!
Like this: RECSET.Open " select proto.b_perf_cma as b_perf_cma from db_dossier sousc,db_produit prod, " & _ " db_protocole proto where sousc.no_police = '" & numero_de_police & "' " & _ " and sousc.cd_dossier = 'SOUSC' " & _ " and sousc.lp_etat_doss not in ('ANNUL','A30','IMPAY') " & _ " and sousc.is_produit = prod.is_produit " & _ " and prod.cd_produit||'/'||'" & strQ & "' = proto.cd_protocole ", _ cnn_Pegase, adOpenDynamic, adLockBatchOptimistic helps to spend some time formatting your SQL so it's more readable (for us and you...)
using two recordset vba excel
I have this code Public Sub CommandButton1_Click() Cells.Clear Dim oConn1 As ADODB.Connection Dim rs1 As ADODB.Recordset Dim rs2 As ADODB.Recordset Set oConn1 = New ADODB.Connection oConn1.ConnectionString = "Provider=SQLOLEDB.1;Password=" & Contraseña.Text & ";Persist Security Info=True;User ID= " & Usuario.Text & "; Initial Catalog =" & bases.Text & ";Data Source= SERVER\BD;" oConn1.ConnectionTimeout = 200 oConn1.Open Set rs1 = New ADODB.Recordset rs1.ActiveConnection = oConn1 rs1.Source = "DECLARE #id INT" & _ "SET #id = ##spid" & _ "INSERT CLIENTES_SALDOS_E (PROCESO_ID, CODIGO_DE_CLIENTE)" & _ "SELECT #id, CODIGO_DE_CLIENTE" & _ "FROM CLIENTES" & _ "WHERE CLIENTES.CODIGO_DE_CLIENTE BETWEEN '" & EXTRA(Ncuenta) & "' AND '" & EXTRA(Ncuenta2) & "'" & _ "EXECUTE sp_Reconstruccion_saldo_doctos "", '" & EXTRA(Fechacorte) & "', #id" Set rs2 = New ADODB.Recordset rs2.ActiveConnection = oConn1 rs2.Source = "SELECT P.NOMBRE_DEPARTAMENTO,M.NOMBRE_MUNICIPIO,R.NOMBRE_TERRITORIO,V.NOMBRE_VENDEDOR,C.CODIGO_DE_CONDICION,E.CODIGO_DE_CLIENTE,C.NOMBRE_CLIENTE,D.CODIGO_MOVIMIENTO," & _ "D.SERIE_DEL_DOCUMENTO,D.NUMERO_DOCUMENTO,(ME.MONTO_TOTAL * ME.CAMBIO_MONEDA_LOCAL) AS MONTO_MONEDA_LOCAL,D.SALDO_MONEDA_LOCAL,CONVERT(VARCHAR(10),D.FECHA_DOCUMENTO,103) AS FECHA_DOCUMENTO," & _ "CONVERT(VARCHAR(10),D.FECHA_VENCIMIENTO,103) AS FECHA_VENCIMIENTO,D.DIAS_DE_ANTIGUEDAD," & _ "CASE WHEN D.DIAS_DE_ANTIGUEDAD =0 THEN D.SALDO_MONEDA_LOCAL ELSE 0 END AS 'NO VENCIDO'," & _ "CASE WHEN D.DIAS_DE_ANTIGUEDAD >=1 AND D.DIAS_DE_ANTIGUEDAD <=15 THEN D.SALDO_MONEDA_LOCAL ELSE 0 END AS 'DE 1 A 15 DIAS'," & _ "CASE WHEN D.DIAS_DE_ANTIGUEDAD >=16 AND D.DIAS_DE_ANTIGUEDAD <=30 THEN D.SALDO_MONEDA_LOCAL ELSE 0 END AS 'DE 16 A 30 DIAS'," & _ "CASE WHEN D.DIAS_DE_ANTIGUEDAD >=31 AND D.DIAS_DE_ANTIGUEDAD <=60 THEN D.SALDO_MONEDA_LOCAL ELSE 0 END AS 'DE 31 A 60 DIAS'," & _ "CASE WHEN D.DIAS_DE_ANTIGUEDAD >=61 AND D.DIAS_DE_ANTIGUEDAD <=90 THEN D.SALDO_MONEDA_LOCAL ELSE 0 END AS 'DE 61 A 90 DIAS'," & _ "CASE WHEN D.DIAS_DE_ANTIGUEDAD >=91 AND D.DIAS_DE_ANTIGUEDAD <=9999 THEN D.SALDO_MONEDA_LOCAL ELSE 0 END AS 'DE 91 A 9999 DIAS'" & _ "FROM CLIENTES C" & _ "INNER JOIN CLIENTES_SALDOS_E E ON E.CODIGO_DE_CLIENTE = C.CODIGO_DE_CLIENTE" & _ "INNER JOIN CLIENTES_SALDOS_D D ON D.CODIGO_DE_CLIENTE = E.CODIGO_DE_CLIENTE AND D.PROCESO_ID = E.PROCESO_ID" & _ "INNER JOIN MOVIMIENTOS_TIPO T ON T.CODIGO_MOVIMIENTO = D.CODIGO_MOVIMIENTO" & _ "INNER JOIN DEPARTAMENTOS P ON C.CODIGO_DE_PAIS = P.CODIGO_DE_PAIS AND C.CODIGO_DEPARTAMENTO = P.CODIGO_DEPARTAMENTO" & _ "INNER JOIN MUNICIPIOS M ON C.CODIGO_DE_PAIS = M.CODIGO_DE_PAIS AND C.CODIGO_DEPARTAMENTO = M.CODIGO_DEPARTAMENTO AND C.CODIGO_MUNICIPIO = M.CODIGO_MUNICIPIO" & _ "INNER JOIN TERRITORIOS R ON C.CODIGO_TERRITORIO = R.CODIGO_TERRITORIO" & _ "LEFT JOIN CLIENTE_VENDEDOR CV ON C.CODIGO_DE_CLIENTE = CV.CODIGO_DE_CLIENTE" & _ "LEFT JOIN VENDEDORES V ON CV.CODIGO_VENDEDOR = V.CODIGO_VENDEDOR" & _ "INNER JOIN MOVIMIENTO_ENC ME ON D.SERIE_DEL_DOCUMENTO = ME.SERIE_DEL_DOCUMENTO AND D.NUMERO_DOCUMENTO = ME.NUMERO_DOCUMENTO AND D.CODIGO_MOVIMIENTO = ME.CODIGO_MOVIMIENTO" & _ "WHERE E.PROCESO_ID = #id AND T.TIPO_TRANSACCION = 'S' AND D.ID_EMPRESA = 'GN' AND D.ID_SUCURSAL = '01' AND D.ID_CENTRO_OPERATIVO = '001' AND D.SALDO_MONEDA_LOCAL > 0" & _ "DELETE CLIENTES_SALDOS_E WHERE PROCESO_ID = #id" & _ "DELETE CLIENTES_SALDOS_D WHERE PROCESO_ID = #id" rs2.Open encabezados Range("A2").CopyFromRecordset rs2 'a = rs1.Fields.Count rs1.Close rs2.Close oConn1.Close MsgBox ("Reporte Generado") Set rs1 = Nothing Set rs2 = Nothing Set oConn1 = Nothing End If End Sub When i run this code, give me a incorrect syntax near 'E' error, I divided the code in two recordset because in only one give me the error: there is to many continuation of lines, but now i have incorrect syntax error. I guess the error is because in the where clause of the recordset 2, makes reference to the variable declared on the recordset 1, and i dont know how tell the query to the E.PROCESO_ID is in the recordset 1. How can i fix this? Thanks
My best guess is the problem is missing spaces here. Right now your statement reads FROM CLIENTES CINNER JOIN CLIENTES_SALDOS but it should read FROM CLIENTES C INNER JOIN CLIENTES_SALDOS So add a space in front of every INNER JOIN.
Why does my script seem to randomly truncate strings?
The script below basically takes a source table and a target table and copies all the records. It works fairly well, but one recurring issue I'm having is that it seems to truncate some strings. Here is one of the error outputs: Error Number: -2147217900 Description: [Microsoft][ODBC SQL Server Driver][SQL S erver]Unclosed quotation mark after the character string 'STRINGSEGMENT^urn:uuid:e9 e91fe151-5w4c-12e1-bac5-25b3a0'. INSERT INTO TableName VALUES ('23189','23189','','','1^^','','12/5/2013 3:37:2 2 PM','fieldvalue','','somethinghere','somethinghere','12/5/2013 9:37:22 AM','123456','1234568798','STRINGSEGMENT^urn:uuid: e91fe151-5w4c-12e1-bac5-25b3a0 Query is 584 characters long If you look at the source data, the string that is truncated looks something like this: STRINGSEGMENT^urn:uuid:e91fe151-5w4c-12e1-bac5-25b3a0004b00^STRINGSEGMENT So it's cutting it off after the 53rd character (highlighted). The entire length of tSQL is only 584 characters long. Why is this happening? WScript.Echo "Setting Vars..." Dim sConnect, tConnect, resultSet, r Dim sDSN, sUserName, sPassWord Dim tDSN, tUserName, tPassWord Dim value sDSN = "mydsn" sUsername = "myusername" sPassword = "mypassword" tDSN = "LOCAL" tUsername = "myusername" tPassword = "mypassword" sTable = "sourceTable" tTable = "targetTable" sSQL = "" 'see below sDSN = "DSN=" & sDSN & ";UID=" & sUsername & ";PWD=" & sPassword & ";" tSQL = "Select TOP 1 ID FROM " & tTable & " ORDER BY ID Desc" tDSN = "DSN=" & tDSN & ";UID=" & sUsername & ";PWD=" & sPassword & ";" Set sConnect = CreateObject("ADODB.Connection") WScript.Echo "Opening connection to source..." sConnect.Open sDSN Set tConnect = CreateObject("ADODB.Connection") WScript.Echo "Opening connection to target..." tConnect.Open tDSN WScript.Echo "Finding Current Record..." Set r = tConnect.Execute(tSQL) On Error Resume Next r.MoveFirst if r.eof Then currentRecord = 1 Err.Clear Do While Not r.eof currentRecord = r("ID") + 1 r.MoveNext Loop r.Close sSQL ="Select * FROM " & sTable & " WHERE ID >= " & currentRecord WScript.Echo "Beginning shadow at record " & currentRecord & "..." Set resultSet = sConnect.Execute(sSQL) resultSet.MoveFirst Do While Not resultSet.eof On Error Resume Next tSQL = "INSERT INTO " & tTable & " VALUES ('" For i = 0 To resultSet.fields.Count - 1 if NOT IsNull(resultSet(i)) Then value = replace(resultSet(i),"'","") 'somewhere around here else value = "" End If tSQL = tSQL & value if i < resultSet.fields.Count - 1 Then tSQL = tSQL & "','" end if Next tSQL = tSQL & "')" 'when the error occurs, the line above doesn't seem to be processed but the line below obviously is... tConnect.Execute(tSQL) If (Err.Number <> 0) Then WScript.Echo "Error Number: " & Err.Number & " Description: " & Err.Description WScript.Echo tSQL WScript.Echo "Query is " & Len(tSQL) & " characters long" WScript.StdIn.ReadLine Err.Clear End If tSQL = "" resultSet.MoveNext Loop resultSet.Close sConnect.Close Set sConnect = Nothing tConnect.Close Set tConnect = Nothing WScript.Quit(0)
I don't know why this is happening, but here is my workaround. I will not accept this as an answer, just wanted to document. Function allowed(n) allowed = true if n = 13 Then allowed = false if n = 14 Then allowed = false End Function Function sanitize(v,i) 'v=value i=index mystr = "" if allowed(i) Then if Not IsNull(v) Then mystr = replace(v,"'","") End If end if sanitize = mystr End Function Basically I'm just manually excluding the columns that have a problem. Notice that I identified a second one. What's really curious is that columns 12 and 13 have identical data in the source database, but column 12 copies fine.