I'm getting a run-time error 3075
I have checked all the parentheses and quotes, everything seems okay but still not running.
'Now Check the database to see if there are existing records for the Month and year in question
txtSQL = "SELECT Count([Rec_ID]) AS CountID FROM [dbo_NBD_EMEA_NBD_Source_Download] Where [Ledger_Year] = " & CurYear & " AND [Ledger_Month] = " & CurMonth & " AND ([Region_Cd] = 'EMEA' OR [Region_Cd] = 'APAC' OR [Region_Cd] = 'INDA');"
Set dbs = CurrentDb
Set Rs = dbs.OpenRecordset(txtSQL, dbOpenSnapshot)
NumRecs = Rs("CountID")
Rs.Close
If NumRecs > 0 Then
Prompt1 = "WARNING... There are " & NumRecs & " Records already in the database for Year " & CurYear & " Month " & CurMonth & Chr(10) & " Do you want to ERASE the existing records and REPLACE them with the NEW RECORDS in your IMPORT FILE " & Chr(10) & Selected_File & "?"
Response1 = MsgBox(Prompt1, Style2, "DELETE EXISTING RECORDS IN DATABASE?")
If Response1 = vbOK Then 'Continue with Delete of existing Records and Import of new
Prompt2 = "Confirm... Existing Records will be deleted and replaced with your new file"
Response2 = MsgBox(Prompt2, Style2, "Confirm Deletions")
If Response2 = vbOK Then
'Run Stored Procedure to delete the records
Me.ProcessStatus.Caption = "Deleting existing records"
Set db = DBEngine.Workspaces(0).OpenDatabase("", False, False, Connect_String)
db.Execute "XPROC1_NBD_EMEA_Source_Download_Delete " & CurYear & " , " & CurMonth, dbSQLPassThrough
Set db = Nothing
Else
If Response2 = vbCancel Then 'If no confirmation of delete then cancel
Me.ProcessStatus.Caption = "Import Canceled"
Exit Sub
End If
End If
Else
If Response1 = vbCancel Then ' Cancel import
Me.ProcessStatus.Caption = "Import Canceled"
Exit Sub
End If
End If
End If
This line does not look to be valid SQL:
db.Execute "XPROC1_NBD_EMEA_Source_Download_Delete " & CurYear & " , " & CurMonth, dbSQLPassThrough
The Execute method will run an action query or execute a supplied SQL statement, it does not evaluate VBA code within another database.
Related
I got problem with one of my subroutines, which job is to convert any passed ListObject (ussually generated by powerquery) into multiple MySQL queries, then send them to database. Queries and progress are shown on userform, that refresh with every query. My problem is that for some reason with some large tables, code starts out very quickly, but at some point it instantly slows down to fraction of speed it started and excel ram usage is increasing by +-1MB/s while running, and after code finish, it stays there.
With smaller tables (low column count, or small values in cells) it can process tens of thousands rows very fast without slowing, but problem comes with some large tables (either higher column count, or big values in cells, for ex. long strings etc...) after like 3k rows.
This sub is responsible for looping thru table, and building insert queries, then every few rows (depending on query length) calls function, that can send any query into selected DB. The problem is in "For i" loop, but i including whole code here.
Public Sub UploadniPayload(DBtabulka As String, Zdroj As ListObject, Optional Databaze As String = "tesu")
If ErrorMode = False Then On Error Resume Next
Dim Prikaz As String, Radek As String, Payload As String, i As Long, x As Long, PocetRadku As Long, PocetSloupcu As Long, DBsloupce As Long
Call VyplnNetInfo(DBIP)
AutoUploader.loading_sql.Value = 0
PocetRadku = Zdroj.DataBodyRange.Rows.Count
PocetSloupcu = Zdroj.DataBodyRange.Columns.Count
DBsloupce = DBPocetSloupcu(DBtabulka, Databaze)
If JeTabulkaPrazdna(Zdroj) = False Then
If (Zdroj.DataBodyRange.Columns.Count + 1) = DBsloupce Then
'PROBLEM APPEARING IN THIS LOOP
For i = 1 To PocetRadku
For x = 1 To PocetSloupcu
If x <= 0 Then Exit For
If x = 1 Then
Payload = "'','" & Zdroj.DataBodyRange(i, x).Text & "'"
Else
Payload = Payload & ",'" & Zdroj.DataBodyRange(i, x).Text & "'"
End If
Next x
Radek = "(" & Payload & ")"
If Prikaz <> vbNullString Then Prikaz = Prikaz & ", " & Radek Else Prikaz = Radek
If i = PocetRadku Or Len(Prikaz) > 2500 Then
AutoUploader.loading_sql.Value = i / PocetRadku
AutoUploader.txtStatus.Caption = "Zpracovávám " & i & "/" & PocetRadku & " řádků"
Prikaz = "INSERT INTO `" & Databaze & "`.`" & DBtabulka & "` VALUES " & Prikaz
Call PrikazSQL(Prikaz, Databaze)
Prikaz = vbNullString
Payload = vbNullString
End If
Next i
Else
Call Zaloguj("System", "Error - počet sloupců v " & Zdroj.Name & " (" & PocetSloupcu & "+1 ID) nesouhlasí s počtem sloupců v " & DBtabulka & "(" & DBsloupce & ")", False)
End If
Else
Call Zaloguj("System", "Error - pokus o upload prázdné tabulky (" & Zdroj.Name & ") do DB (" & DBtabulka & ")", False)
End If
If AutoUploader.chb_Uklizecka.Value = True Then Call VycistiTabulku(Zdroj)
End Sub
And this is my function responsible for sending queries into database.
Sometimes i use it for pulling single value from database, so it acts as string, but when i need only insert, i just using Call. DBIP, DBUser and DBPass are global variables.
Public Function PrikazSQL(ByRef Prikaz As String, Optional Databaze As String = "tesu") As String
On Error GoTo ErrHandler
AutoUploader.IconDirectSQL.BackColor = vbGreen
AutoUploader.txtKUK.Value = Prikaz
'If ErrorMode = True Then Call Zasifruj
DoEvents
Dim Pripojeni As ADODB.Connection, RS As ADODB.Recordset
Set Pripojeni = CreateObject("ADODB.Connection")
Set RS = CreateObject("ADODB.RecordSet")
Pripojeni.Open "" & _
"DRIVER={MySQL ODBC 8.0 UNICODE Driver}" & _
";SERVER=" & DBIP & _
";DATABASE=" & Databaze & _
";USER=" & DBUser & _
";PASSWORD=" & DBPass & _
";Option=3"
With RS
.CursorLocation = adUseClient
.LockType = adLockBatchOptimistic
.Open Prikaz, Pripojeni
.ActiveConnection = Nothing
End With
Pripojeni.Close
Set Pripojeni = Nothing
If RS.Fields.Count > 0 Then PrikazSQL = RS(0)
Set RS = Nothing
AutoUploader.IconDirectSQL.BackColor = vbWhite
DoEvents
Exit Function
ErrHandler:
RS.ActiveConnection = Nothing
If Not Pripojeni Is Nothing Then
Pripojeni.Close
Set Pripojeni = Nothing
End If
If RS.Fields.Count > 0 Then PrikazSQL = RS(0)
Set RS = Nothing
AutoUploader.IconDirectSQL.BackColor = vbWhite
DoEvents
Call Debuger("ERROR:" & vbCrLf & Err.Description & vbCrLf & vbCrLf & "QUERY:" & vbCrLf & Prikaz, "PrikazSQL")
End Function
Code above is only part of the autonomous bot, on start it apply these settings:
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
DoEvents is used only for refreshing userform, instead of repaint.
I try to unload any object or variable, that i dont need, but i think i am missing something important. Any other part of code runs fine. Any help would be very appreciated.
I have a database where i can add a full name of a person, and i am trying to implement a search function using a textBox and a button but i only want to search for the first or last name not necessarily entering the full name.
I tried using SELECT FROM WHERE CONTAINS like this:
OleDbCommand cmd = con.CreateCommand();
cmd.CommandType = CommandType.Text;
cmd.CommandText = "SELECT * FROM Table WHERE CONTAINS (column, '"+textBox.Text+"')";
But i keep getting this error:
Syntax error (missing operator) in query expression 'CONTAINS (column,'the text i tried to search')'.
I also tried changing the + to % or * or & but still it didn’t work.
Contains is not valid Access SQL. Use Like:
cmd.CommandText = "SELECT * FROM Table WHERE [YourNameField] Like '*" + textBox.Text + "*')";
Here is an example of a search such as you want:
Private Sub cmdFind_DisplayName_Click()
Dim dbs As Database, rstPatient As Recordset
Dim txtDisplayName, strQuote As String
strQuote = Chr$(34)
On Error GoTo ErrorHandler
Me.OrderBy = "DISPLAYNAME"
Me.OrderByOn = True
Set dbs = CurrentDb
Set rstPatient = Me.RecordsetClone
txtDisplayName = Trim(InputBox("Please Enter Patient Name ", "Patient Find By Name"))
txtDisplayName = UCase(txtDisplayName) & "*"
If IsNull(txtDisplayName) Then
MsgBox ("No Patient Name Entered - Please Enter a Valid Patient Name")
Else
rstPatient.FindFirst "[DISPLAYNAME] Like " & strQuote & txtDisplayName & strQuote
If Not (rstPatient.NoMatch) Then
Me.Bookmark = rstPatient.Bookmark
Me.Refresh
Else
MsgBox ("Patient Not Found - Please Enter a New Patient Name")
End If
End If
GoTo Exit_cmdFind_Click
ErrorHandler:
MsgBox LTrim(RTrim(Me.NAME)) + "." + "Patient Find By Display Name - " + "Error: " + AccessError(Err.Number)
Exit_cmdFind_Click:
rstPatient.Close
Set dbs = Nothing
Set rstPatient = Nothing
End Sub
Create 1 textbox (txtMain) and search command button(btnSearch) to execute SQL. Then add a listbox (listResult) to display results.
Private Sub btnSearch_Click()
Dim mainSQL As String
mainSQL = " SELECT YOUR_FIELD_NAME " & _
" FROM MasterReg " & _
" WHERE Left(,InStr(YOUR_FULL_NAME_FIELD,' ')-1) LIKE '" & me.txtMain & "*'" & _ ' Firstname Search
" OR RIGHT( YOUR_FULL_NAME_FIELD,Len( YOUR_FULL_NAME_FIELD )-InStr( YOUR_FULL_NAME_FIELD,' ')) LIKE '" & me.txtMain & "*'" 'Surname Search
Me.listResult.SetFocus
Me.listResult.RowSource = mainSQL
Me.listResult.Requery
End Sub
I am trying to write the user name who is currently logged in to records in the table X that is used to update table Y with new records from it.
Here is the code I use:
Private Sub UPD_Click()
On Error GoTo Err_UPD_Click
DoCmd.TransferDatabase acImport, "Microsoft Access", "D:\Working\Test.mdb", acTable, "tblTest", "tblTest_Import", False
DoCmd.RunSQL "ALTER TABLE tblTest_Import ADD COLUMN [CreatedBy] Text(25);"
Dim myDB As Database
Set myDB = CurrentDb
myDB.Execute "UPDATE tblTest_Import " _
& "SET [tblTest_Import].[CreatedBy] = [Forms]![frmLogin]![txtUserName];"
myDB.Execute "INSERT INTO tblMain(Year, CreatedBy)"_
& "SELECT tblTest_Import.Year, tblTest_Import.CreatedBy " _
& "FROM tblTest_Import " _
& "WHERE (((Exists (SELECT * FROM tblMain " _
& "WHERE tblMain.ID = tblTest_Import.ID))=False));"
Exit_UPD_Click:
Exit Sub
Err_UPD_Click:
MsgBox Err.Description
Resume Exit_UPD_Click
End Sub
Form frmLogin stays open but hidden (Me.Visible = False).
The problem is the field CreatedBy in tblTest_Import does not get updates and Access returns this message: "Too few parameters. Expected 1." And none of lines in the code gets highlighted.
I tried to add
Dim frmLogin As Form
Set frmLogin = Screen.ActiveForm
but it didn't help.
What is wrong with my code?
I found solution :)
I just needed to add several quotes to this part of code
myDB.Execute "UPDATE tblTest_Import " _
& "SET [tblTest_Import].[CreatedBy] = '" & [Forms]![frmLogin]![UserName] & "';"
Bingo!
I inherited this Access Database for a client and was tasked with updating some things in it. Unfortunately I don't know much about VBA/Access. I keep receiving the error Runtime error 2465: Can't find the field "|1" referenced on the DoCmd.SendObject line. I've done a lot of searching and it's such a cryptic error I'm getting nowhere. Can someone explain to me what is wrong here? I'm assuming it's a syntax issue somewhere or I'm using variables wrong or something.
Private Sub cbCompleted_AfterUpdate()
If cbCompleted = -1 Then
tbCompleted = Date
tbCompleted.Locked = True
Doctor_Name.Locked = True
Department.Locked = True
Start_Date.Locked = True
Specialty.Locked = True
Doctor_.Locked = True
Taxonomy_.Locked = True
DepartmentCombo.Locked = True
UPIN_.Locked = True
SpecialtyCombo.Locked = True
Dim sd As String
Dim dn As String
sd = "" & [Start Date]
dn = "" & [Doctor Name]
DoCmd.SendObject acSendNoObject, , , "Tim,Keith,Yvonne,Sandy,susan#domain.org,Vicki#domain.org", "Tom,Barbara,Rachael,Penny,Troy,bernasue#domain.org", , "Doctor " & dn & " " & "Start Date:" & " " & sd, dn & " " & "is scheduled to start" & sd & vbNewLine & "NPI# :" & [NPI#] & vbNewLine & "Specialty: " & [Speciality#] & vbNewLine & "Department/Practice: " & [Department#] & vbNewLine & "Provider# for HR/Acctg: " & [Doctor#], True
Else
'[snip] Unlock all fields locked above
End If
End Sub
Thanks much
Copy from: https://softwareengineering.stackexchange.com/questions/158330/cascading-comboboxes
ok so i have a form, in Access 2010, with 1 Textbox and 3 ComboBoxes (1 Enabled & 2 Disabled).
the first ComboBox is not tied to the datasource but is subjective to the other 2 comboboxes. So i handled the Click event for the first Combobox to then make the other 2 enabled, and preload the 2nd ComboBox with a custom RowSource SQL Script dynamically built based on the 1st ComboBox Value.
This all works great for New information but when i goto review the information, via Form, its back to the New mode on the controls.
Question:
What event do i need to handle to check if the current Form Data contains data for the Control Source of the Controls?
As i would express it in Logic (its a mix between C & VB, i know but should get the pt acrossed):
DataSet ds = Form.RowSet
if (ds = Null) then
cbo2.enabled = false
cbo3.enabled = false
else
cbo2.rowsource = "select id, nm from table"
cbo2.value = ds(3)
cbo3.value = ds(4)
end if
... do some other logic ...
Updated Logic - Still problem, cant catch for RecordStatus for some reason (gives 3251 Run-Time Error)
Private Sub Form_Current()
Dim boolnm As Boolean: boolnm = (IsNull(txtName.Value) Or IsEmpty(txtName.Value))
Dim booltype As Boolean: booltype = IsNull(cboType.Value)
Dim boolfamily As Boolean: boolfamily = IsNull(cboType.Value)
Dim boolsize As Boolean: boolsize = IsNull(cboType.Value)
Dim rs As DAO.Recordset: Set rs = Me.Recordset
MsgBox rs.AbsolutePosition
' If rs.RecordStatus = dbRecordNew Then
' MsgBox "New Record being inserted, but not committed yet!", vbOKOnly
' Else
' MsgBox rs(0).Name & " - " & rs(0).Value & vbCrLf & _
' rs(1).Name & " - " & rs(1).Value & vbCrLf & _
' rs(2).Name & " - " & rs(2).Value & vbCrLf & _
' rs(3).Name & " - " & rs(3).Value
' End If
'MsgBox "Name: " & CStr(boolnm) & vbCrLf & _
"Type: " & CStr(booltype) & vbCrLf & _
"Family: " & CStr(boolfamily) & vbCrLf & _
"Size: " & CStr(boolsize), vbOKOnly
End Sub
Here is the final result, with Remou's assistance, and this is only a precursor to the end result (which is out of the context of the question).
Private Sub Form_Current()
If Me.NewRecord Then <=======================
cboType.Value = 0
cboType.Enabled = True
cboFamily.Enabled = False
cboSize.Enabled = False
Else
Dim rs As DAO.Recordset: Set rs = Me.Recordset
'get Family ID
Dim fid As String: fid = rs(2).Value
'Build SQL Query to obtain Type ID
Dim sql As String
sql = "select tid from tblFamily where id = " & fid
'Create Recordset
Dim frs As DAO.Recordset
'Load SQL Script and Execute to obtain Type ID
Set frs = CurrentDb.OpenRecordset(sql, dbOpenDynaset, dbReadOnly)
'Set Type ComboBox Value to Type ID
cboType.Value = frs(0)
cboType_Click 'Simulate Click Event since the Value has changed
'Make sure all 3 Comboboxes are enabled and useable
cboType.Enabled = True
End If
End Sub