VBA Adodb : concatenation of values - excel

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...)

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

Getting the value from cell

I want to get the value (T28200006) from Range("C6").
I get this error:
Public Sub INFO_PROTO1(ByRef strQ As String)
Dim RECSET As New ADODB.Recordset, numero_de_police
If Len(numero_de_police) > 0 Then
RECSET.Open " select sousc.is_produit 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 ", cnn_Pegase, adOpenDynamic, adLockBatchOptimistic
With Worksheets("1 - Feuille de Suivi Commercial").Range("Calcul_CMA_Origine")
Your query value is not a number, so you need to quote it in your SQL:
..." where sousc.no_police = '" & numero_de_police & "' and...

Compile Error: Procedure Too Large help needed

I'm working on a large Excel project that requires entering a lot of data spread out over the worksheet that needs to be entered as quick as possible. To try and aide with the entry, I've created a number of UserForms that the user would enter the data into. One such form returns the above "Process Too Large" error when trying to transfer the data.
I understand why the error pops up - it's far too long. I've included the code for one such entry (slightly modified of course) and was wondering how I would be able to truncate it?
Dim ws As Worksheet
Dim i As Long
Set ws = ThisWorkbook.Sheets("STOCK")
' 101
If entry101.Value <> "" Then
Dim NUM101 As String
If com101.Value <> "" Then
NUM101 = "# - " & UCase(com101.Value)
Else
NUM101 = ""
End If
If cmb101.Value = "FULL" Then
ws.Range("_101").Value = UCase(code101.Value) & " " & Chr(10) & UCase(com101.Value) & " - FULL " & Chr(10) & " "
End If
If cmb101.Value = "OUT OF STOCK" Then
ws.Range("_101").Value = UCase(com101.Value) & " OUT OF STOCK " & Chr(10) & UCase(code101.Value) & " " & Chr(10) & " "
End If
If cmb101.Value = "SHIPPED" Then
ws.Range("_101").Value = UCase(code101.Value) & " " & Chr(10) & " - SHIPPED " & Chr(10) & NUM101
End If
If cmb101.Value = "DAMAGED" Then
ws.Range("_101").Value = UCase(code101.Value) & " DAMAGED " & Chr(10) & " "" & Chr(10) & NUM101"
End If
If cmb101.Value = "LOW STOCK" Then
ws.Range("_101").Value = UCase(com101.Value) & " LOW-STOCK " & Chr(10) & UCase(code101.Value) & " " & Chr(10) & " "
End If
If cmb101.Value = "RETURN" Then
ws.Range("_101").Value = UCase(code101.Value) & " " & Chr(10) & "RETURNED - " & UCase(com101.Value) & " " & Chr(10) & " "
End If
If cmb101.Value = "" Then
ws.Range("_101").Value = UCase(code101.Value) & Chr(10) & " - UNKNOWN CONDITION"
End If
End If
The UserForm has two text boxes ("code101" & "com101") and a single ComboBox ("cmb101") for each entry. The above code needs to be applied to a range from "_101" to "_143" so needs to repeat 43 times.
Any help would be greatly appreciated. Thank you all.
Something like this (untested):
Dim ws As Worksheet, vCom, vCode
Dim i As Long, s, num As String
Set ws = ThisWorkbook.Sheets("STOCK")
For i = 101 To 143
If Me.Controls("entry" & i).Value <> "" Then
vCom = UCase(Me.Controls("com" & i).Value)
vCode = UCase(Me.Controls("code" & i).Value)
num = IIf(vCom <> "", "# - " & vCom, "")
s = ""
Select Case Me.Controls("cmb" & i).Value
Case "FULL": s = vCode & " " & Chr(10) & vCom & " - FULL " & Chr(10) & " "
Case "OUT OF STOCK": s = vCom & " OUT OF STOCK " & Chr(10) & vCode & " " & Chr(10) & " "
Case "SHIPPED": s = vCode & " " & Chr(10) & " - SHIPPED " & Chr(10) & num
'etc
'etc
End Select
If Len(s) > 0 Then ws.Range("_" & i).Value = s
End If
Next i

EOF/BOF error in Excel but SQL statement returns records in Access

Newbie here.
I use Excel as a front end and Access as a back end to store data. I am trying to take a query and write the values to an Access table using VBA in Excel. I get an Either BOF or EOF is True error, and when I run the SQL statement in Access, I get records.
Any feedback would be very much appreciated. Thank you in advance.
Here is my code:
Sub Write_Timesheet_AJ()
'**********************************************JGT**********************************************
'Transpose Data for HCS
'2018.09.17
'**********************************************JGT**********************************************
strPath1 = "C:\Reports\Timesheets\"
strFile1 = "Timesheets.accdb"
strDB = strPath1 & strFile1
Conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & strDB & "; Persist Security Info=False;"
Conn.Open strDB
Conn.CursorLocation = adUseClient
'Clear table
strSQL = "Delete * From tbl_Timesheet_AJ;"
Set rs2 = Conn.Execute(strSQL)
'Transpose Data
strSQL = "Select VisitDate As VisitDt, PatientName, vw_Days_Worked_AJ.CaregiverCode As CaregiverCode, CaregiverName as AideName, CoordinatorName As Coordinator, " _
& "Street_1 As Street1, Street_2 As Street2, City1 As City, State1 as State, Zip, [Language] as L1 " _
& "From vw_Days_Worked_AJ Left Join vw_Caregiver_Info_AJ On vw_Days_Worked_AJ.CaregiverCode = vw_Caregiver_Info_AJ.CaregiverCode;"
Set rs1 = Conn.Execute(strSQL)
If rs1.RecordCount = 0 Then 'Record count check
Debug.Print strSQL
Debug.Print rs1.BOF
Debug.Print rs1.EOF
rs1.Close
Set rs1 = Nothing
Conn.Close
' MsgBox "There are no records; please check data."
Else
rs1.MoveFirst
rsCount1 = rs1.RecordCount
ReDim arrData1(rsCount1)
For loopX = 1 To rsCount1
With arrData1(loopX)
.VisitDt = Format(rs1.Fields("VisitDt"), "m/dd")
.WkEndDt = Get_Fri_Dt(CDate(rs1.Fields("VisitDt")))
.DayOfWk = Left(Get_Day_of_Wk(CDate(rs1.Fields("VisitDt"))), 3)
.PatientName = rs1.Fields("PatientName")
.CaregiverCode = rs1.Fields("CaregiverCode")
.AideName = rs1.Fields("AideName")
.Coordinator = rs1.Fields("Coordinator")
If IsNull(rs1.Fields("Street1")) Then .Street1 = " " Else .Street1 = rs1.Fields("Street1")
If IsNull(rs1.Fields("Street2")) Then .Street2 = " " Else .Street2 = rs1.Fields("Street2")
If IsNull(rs1.Fields("City")) Then .City = " " Else .City = rs1.Fields("City")
If IsNull(rs1.Fields("State")) Then .State = " " Else .State = rs1.Fields("State")
If IsNull(rs1.Fields("Zip")) Then .Zip = " " Else .Zip = rs1.Fields("Zip")
If IsNull(rs1.Fields("L1")) Then .L1 = " " Else .L1 = rs1.Fields("L1")
strInsert = "Insert Into tbl_Timesheet_AJ " _
& "(WkEndDt, PatientName, CaregiverCode, AideName, Coordinator, " & .DayOfWk & ", " _
& "AideName2, CaregiverCode2, Street1, Street2, City, State, Zip, L1) " _
& "Values (#" & .WkEndDt & "#, '" & .PatientName & "', '" & .CaregiverCode & "', " _
& "'" & .AideName & "', '" & .Coordinator & "', '" & .VisitDt & "', '" & .AideName & "', " _
& "'" & .CaregiverCode & "', '" & .Street1 & "', '" & .Street2 & "', '" & .City & "', " _
& "'" & .State & "', '" & .Zip & "', '" & .L1 & "');"
Set rs2 = Conn.Execute(strInsert)
rs1.MoveNext
End With
Next loopX
rs1.Close
Set rs1 = Nothing
Conn.Close
End If
End Sub

Excel VBA & Access Query - Insert data into Table from another Table and data from Excel sheet

I am using Excel VBA to transfer data from Access table 1 to table 2 with Insert Into query. Access query below work fine:
"INSERT INTO " & _
"tblTable2 ([Col_1], [Col_2], [Col_3]) " & _
"SELECT " & _
"tblTable1.[Data_1], tblTable1.[Data_2], tblTable1.[Data_3] " & _
"FROM " & _
"tblTable1 " & _
"WHERE " & _
"tblTable1.[Data_1] = " & Sheet1.Range("D3").Value
Than Table 2 was added new column (Col_4) which the data will be from excel sheet directly. I do written the code (shown below) and it is not work.
"INSERT INTO " & _
"tblTable2 ([Col_4], [Col_1], [Col_2], [Col_3]) " & _
"VALUES (" & sheet2.Range("F1").value & ", " & _
"(SELECT " & _
"tblTable1.[Data_1], tblTable1.[Data_2], tblTable1.[Data_3] " & _
"FROM " & _
"tblTable1 " & _
"WHERE " & _
"tblTable1.[Data_1] = " & Sheet1.Range("D3").Value & "))"
Is any code above was inaccurate?

Resources