I would like to delete all records in the field "pathway" in the table CUSTOMER that is in the backend (offline) database.
So far I have this, but it does not work with DELETE statement
Sub delpath()
Dim dbinputC As String
dbinputC = "[" & Application.CurrentProject.Path & "\CUSTOMER.accdb" & "]"
DoCmd.RunSQL "DELETE pathway FROM " & dbinputC & ".SPECPATH (WHERE pathway <> Null);"
End Sub
Or
Dim dbinputC As String
dbinputC = "'" & Application.CurrentProject.Path & "\CUSTOMER.accdb" & "'"
DoCmd.RunSQL "DELETE pathway FROM SPECPATH (WHERE pathway <> Null) IN " & dbinputC & ";"
Private Sub Test_Clear_Data
Clear_Data "SPECPATH", "Pathway"
End Sub
Private Sub Clear_Data(Table_Name as String, Column_Name As String)
Dim Connection_Path As String
Dim Source_Recset As Object
'Assumes "Clear_Data_Query" already exists
Set Source_Recset = CurrentDB.QueryDefs("Clear_Data_Query")
Source_Recset.SQL = CStr("Update " & Table_Name & " SET [" & Table_Name & "].[" & Column_Name & "] = NULL WHERE [" & Table_Name & "].[" & Column_Name & "] IS NOT Null" & ";")
Source_Recset.Execute
Source_Recset.Close
End Sub
Source_Recset.SQL should get "UPDATE SPECPATH SET [SPECPATH].[Pathway] = NULL Where [SPECPATH].[Pathway] IS NOT NULL;" If table is SPECPATH and Column Name is Pathway
Since you are referencing an offline database i included code to append the table temporarily and remove it after (code is not needed if you leave the table defined in the access file"
Private Sub Clear_Offline_Data(Share_Folder as String, File_Name as String, Table_Name as String, Column_Name As String)
Dim Connection_Path As String
Dim Source_Recset As Object
Dim Destination_Recset As Object
'Create Table To Network Data
Set Destination_Recset = currentDB.CreateTableDef("Offline_Data_Table")
Connection_Path = ";DATABASE=" & ShareFolder & "\" & File_Name
Destination_Recset.Connect = Connection_Path
Destination_Recset.SourceTableName = Table_Name
currentDB.TableDefs.Append Destination_Recset
currentDB.TableDefs.Refresh
'Create Temp_Data From Network Table
Set Source_Recset = CurrentDB.CreateQueryDef("Clear_Data_Query")
Source_Recset.SQL = CStr("Update Offline_Data_Table SET [Offline_Data_Table]." & Column_Name & " = NULL WHERE [Offline_Data_Table]." & Column_Name & " IS NOT Null" & ";")
Source_Recset.Execute
Source_Recset.Close
'Remove Table to network data
currentDB.TableDefs.Delete "Offline_Data_Table"
currentDB.TableDefs.Refresh
'Remove Query
currentDB.QueryDefs.Delete "Clear_Data_Query"
currentDB.QueryDefs.Refresh
End Sub
A delete query deletes rows, not fields.
You must use an update query that updates field pathway.
I guess that it worked after all:
Sub delpath()
Dim dbinputC As String
dbinputC = "[" & Application.CurrentProject.Path & "\CUSTOMER.accdb" & "]"
DoCmd.RunSQL "DELETE pathway FROM " & dbinputC & ".SPECPATH WHERE pathway Is Not Null;"
End Sub
Related
There is a button on a report that exports the underlying query of the report to excel. This function works fine as it would but I need it to take the criteria of the report. I have a massive reporting manager that will set the criteria for the report and then will open it up.
To make it easy, I want to pass me.filter to a variable which works in a different sub, but here my problem is that I need to pass the filter to be properly formatted for an sql statement I assume? The other sub just uses it as a [WhereCondition] for an open report command.
For clarification, the portion getreportsource() is a module that gets the reports source and it works fine.
Here are some example outputs of the variables as well as the code:
strRptName: TotalSalesForYear
strRptSource: qryMainDashboard
FilterCondition: TxnDate >= #11/1/2017# AND TxnDate <= #11/30/2017#
Private Sub cmdExcel_Click()
Dim strRptName As String
Dim strRptSource As String
Dim vardate As String
Dim varExportPath As String
Dim FilterCondition As String
Dim oExcel
FilterCondition = Me.filter
' Get the Report Name
strRptName = Screen.ActiveReport.Name
' Get the RecordSource of the Report from a module
strRptSource = GetReportSource(strRptName)
'Present Date
vardate = Format$(Now(), "YYYY.MM.DD_HH-mm-ss")
'Path of export
varExportPath = "C:\Users\Public\Downloads\"
'Check for terminating backslash ExportLinkReportsOut filepath.
If Right(varExportPath, 1) <> "\" Then
varExportPath = varExportPath & "\"
End If
varExportPath = varExportPath & strRptName & ".xlsx"
' set dao and create temp table
Dim cdb As DAO.Database, qdf As DAO.QueryDef
Const tempTableName = "_tempTbl"
Set cdb = CurrentDb
'deletes temp table and handles error
On Error Resume Next
DoCmd.DeleteObject acTable, tempTableName
On Error GoTo 0
Set qdf = cdb.CreateQueryDef("")
qdf.SQL = "SELECT * INTO [" & tempTableName & "] FROM [" & strRptSource & "] where filtercondition"
qdf.Execute
Set qdf = Nothing
Set cdb = Nothing
' export spreadsheet with the temp table, the export path, and then open the spreadsheet
DoCmd.TransferSpreadsheet acExport, , tempTableName, varExportPath, True
Set oExcel = GetObject(varExportPath)
oExcel.Application.Visible = True
oExcel.Parent.Windows(1).Visible = True
End Sub
Everything works when I change qdf.SQL = "SELECT * INTO [" & tempTableName & "] FROM [" & strRptSource & "] where filtercondition" to qdf.SQL = "SELECT * INTO [" & tempTableName & "] FROM [" & strRptSource & "] "
Problem is there is no filter when I drop filtercondition, obviously.
The error I keep getting is "Run-time error '3061': Too few paramters. Expected 1."
Anyone have any pointers?
The problem is that you aren't concatenating the filter condition. Your query just states WHERE filtercondition, not WHERE TxnDate >= #11/1/2017# AND TxnDate <= #11/30/2017#
Change qdf.SQL = "SELECT * INTO [" & tempTableName & "] FROM [" & strRptSource & "] where filtercondition" to qdf.SQL = "SELECT * INTO [" & tempTableName & "] FROM [" & strRptSource & "] WHERE " & filtercondition
I use the following code in vba access to update a column of a table, but it is not working. Please help me.
Best regards.
Dim sqlupdate As String
sqlupdate = "UPDATE Assay" _
& "SET Assay.assay_repeat = " & 0 & "" _
& "WHERE (((Assay.[assay_repeat])= " & 1 & "));"
DoCmd.RunSQL sqlupdate
You have an extra double quote and are missing a couple of spaces - try it like this:
Dim sqlupdate As String
sqlupdate = "UPDATE Assay" _
& " SET Assay.assay_repeat = " & 0 & " _
& " WHERE (((Assay.[assay_repeat])= " & 1 & "));"
You just missed space chars at end of the table name and before where.
Dim sqlupdate As String
sqlupdate = "UPDATE Assay " _
& "SET Assay.assay_repeat = " & 0 & " " _
& "WHERE (((Assay.[assay_repeat])= " & 1 & "));"
Here is a great way to convert a SQL string to VBA code.
Creating the form
The form just needs two text boxes, and a command button. SQL statements can be quite long, so you put the text boxes on different pages of a tab control.
Create a new form (in design view.)
Add a tab control.
In the first page of the tab control, add a unbound text box.
Set its Name property to txtSql.
Increase its Height and Width so you can see many long lines at once.
In the second page of the tab control, add another unbound text box.
Name it txtVBA, and increase its height and width.
Above the tab control, add a command button.
Name it cmdSql2Vba.
Set its On Click property to [Event Procedure].
Click the Build button (...) beside this property.
When Access opens the code window, set up the code like this:
Private Sub cmdSql2Vba_Click()
Dim strSql As String
'Purpose: Convert a SQL statement into a string to paste into VBA code.
Const strcLineEnd = " "" & vbCrLf & _" & vbCrLf & """"
If IsNull(Me.txtSQL) Then
Beep
Else
strSql = Me.txtSQL
strSql = Replace(strSql, """", """""") 'Double up any quotes.
strSql = Replace(strSql, vbCrLf, strcLineEnd)
strSql = "strSql = """ & strSql & """"
Me.txtVBA = strSql
Me.txtVBA.SetFocus
RunCommand acCmdCopy
End If
End Sub
http://allenbrowne.com/ser-71.html
I recommend you use Recordsets.
Private Sub Update_My_Records(Parent As Object)
Dim Data_Recset As Object
Dim Parent_Reference As Object
Set Data_Recset = Parent_Reference.Application.DBEngine.Workspaces(0).Databases(0).OpenRecordset("SELECT * FROM Assay WHERE assay_repeat = " & 0 & ";", DB_OPEN_DYNASET)
Data_Recset.MoveLast
Data_Recset.MoveFirst
Data_Recset.Edit
Data_Recset.Fields("assay_repeat") = 1
Data_Recset.Update
Data_Recset.Close
Set Data_Recset = Nothing
End Sub
assumptions
Parent has reference to Access.Application. (I usually pass: Form.Module.Parent reference to Sub/Function)
the table or query "Assay" already exists.
You only need to update 1 row at a time
But if you want to use Queries In Your Form:
Private Sub Query_Definition_Update()
Dim Obj_Qdef As Object
Dim Query_Name As String
Query_Name = "Q_Assay"
Me.Form.Application.DBEngine.Workspaces(0).Databases(0).QueryDefs.Refresh
Set Obj_Qdef = Me.Form.Application.DBEngine.Workspaces(0).Databases(0).QueryDefs(Query_Name)
Obj_Qdef.SQL = Query_Update(1)
Debug.Print Obj_Qdef.SQL
Obj_Qdef.Execute
''When finished updating
Obj_Qdef.Close
Set Obj_Qdef = Nothing
End Sub
'------------------------------------------------------------'
Private Function Query_Update(New_Value as Integer) As String
Query_Update = "UPDATE Assay" & _
" SET Assay.assay_repeat = " & 0 & "" & _
" WHERE (((Assay.[assay_repeat])= " & New_Value & "));"
End Sub
rs2.FindFirst "[aniin] ='" & strTemp & "'"
aniin being an alias from the SQL within the function.
also tried ...
rs2.FindFirst (niin = newdata)
is my attempt to isolate the field name niin from the record value in the form from the one in the strSQL2. All my attempts have failed. I am trying to make sure that what the user typed in does match the list from the SQL string.
Private Function IsPartOfAEL(newdata) As Boolean
On Error GoTo ErrTrap
Dim db2 As DAO.Database
Dim rs2 As DAO.Recordset
Dim strTemp As String
strSQL2 = "SELECT tbl_ael_parts.master_ael_id, tbl_master_niin.niin as aniin " & vbCrLf & _
"FROM tbl_master_niin INNER JOIN tbl_ael_parts ON tbl_master_niin.master_niin_id = tbl_ael_parts.master_niin_id " & vbCrLf & _
"WHERE (((tbl_ael_parts.master_ael_id)= " & Forms!frm_qry_niin_local!master_ael_id & "));"
Set db2 = CurrentDb
Set rs2 = db2.OpenRecordset(strSQL2)
strTemp = newdata
If rs2.RecordCount <> 0 Then
rs2.FindFirst "[aniin] ='" & strTemp & "'"
If rs2.NoMatch Then
IsPartOfAEL = False
Else
IsPartOfAEL = True
End If
Else
MsgBox "Query Returned Zero Records", vbCritical
Exit Function
End If
rs.Close
Set rs2 = Nothing
Set db2 = Nothing
ExitHere:
Exit Function
ErrTrap:
MsgBox Err.description
Resume ExitHere
End Function
First: You should never include a constant like vbCrLf when building a query string. The query parser doesn't care if there's a linefeed, and in fact this can sometimes cause issues.
Your code seems to do nothing more that verify whether the value in newdata exists in the tbl_ael_parts and is associated with the value master_ael_id value currently showing on frm_qry_niin_local. If so, then just use DCount, or use this for your query:
strSQL2 = "SELECT tbl_ael_parts.master_ael_id INNER JOIN tbl_ael_parts ON
tbl_master_niin.master_niin_id = tbl_ael_parts.master_niin_id WHERE (((tbl_ael_parts.master_ael_id)=
" & Forms!frm_qry_niin_local!master_ael_id & ") AND niin=" & newdata & ");"
Dim rst As DAO.Recordset
Set rst = currentdb.OPenrecordset(strsql2)
If (rst.EOF and rst.BOF) Then
' no records returned
Else
' records found
End If
If niin is a Text field:
strSQL2 = "SELECT tbl_ael_parts.master_ael_id INNER JOIN tbl_ael_parts ON
tbl_master_niin.master_niin_id = tbl_ael_parts.master_niin_id WHERE (((tbl_ael_parts.master_ael_id)=
" & Forms!frm_qry_niin_local!master_ael_id & ") AND (niin='" & newdata & "'));"
If both niin and master_ael_id are Text fields:
strSQL2 = "SELECT tbl_ael_parts.master_ael_id INNER JOIN tbl_ael_parts ON
tbl_master_niin.master_niin_id = tbl_ael_parts.master_niin_id WHERE (((tbl_ael_parts.master_ael_id)=
'" & Forms!frm_qry_niin_local!master_ael_id & "') AND (niin='" & newdata & "'));"
I have an Access database that I need to reverse engineer into a website (app & data).
I just tried opening it with Outlook 2013 but I get an error that the database has replication enabled and it created with an earlier version of Access (something to that affect).
I assume it's just the replication that's the issue. Is there a way to remove the replication so I can poen it in Access 2013?
So it's not an easy job to unreplicate a database.
First I found WV Mitchell's VBA script that copies your tables into a new database:
http://www.wvmitchell.com/tips/Removing%20Access%20Replication.htm
That doesn't copy the Primary Keys or the Relationships, so I wrote a few quick and dirty VBA scripts to help with that.
Step 1: In the MakeOneTable function from the above script, I added this (above the db.Close line):
Dim td As TableDef
Dim idxLoop As Index
Set td = db.TableDefs(TableName)
For Each idxLoop In td.Indexes
If idxLoop.Primary = True Then
Dim colnames As String
colnames = idxLoop.Fields
colnames = Replace(colnames, ";+", "],[")
colnames = Replace(colnames, "+", "[")
colnames = colnames & "]"
Debug.Print "DoCmd.RunSQL ""CREATE INDEX [PrimaryKey] ON [" & TableName & "] (" & colnames & ") With Primary;"""
Exit For
End If
Next idxLoop
That will output to the Debug (Immediate) Window some VBA code for creating the primary keys (as well as creating the new database and exporting the data to it - MV Mitchell's code). Copy that VBA code, put it into a module/macro in the new database, and run it - and it should create the Primary Keys.
Step 2: In the Old (replicated) database, run this VBA code, which will generate some more VBA code for creating the relationships:
Sub GenerateRelationshipCode()
Dim db As DAO.Database
Set db = CurrentDb()
Dim rs As DAO.Recordset
Set rs = db.OpenRecordset("SELECT DISTINCT szRelationship,szObject,szReferencedObject FROM MSysRelationships ORDER BY szObject,szReferencedObject")
rs.MoveFirst
Do While Not rs.EOF
Dim rsFields As DAO.Recordset
Set rsFields = db.OpenRecordset("SELECT * FROM MSysRelationships WHERE szRelationship = '" & Replace(rs.Fields(0), "'", "''") & "'")
Dim PKFields As String, PKTable As String, FKFields As String, FKTable As String
PKFields = "": PKTable = "": FKFields = "": FKTable = ""
Do While Not rsFields.EOF
PKFields = PKFields & rsFields("szReferencedColumn") & ","
PKTable = rsFields("szReferencedObject")
FKFields = FKFields & rsFields("szColumn") & ","
FKTable = rsFields("szObject")
rsFields.MoveNext
Loop
PKFields = Left(PKFields, Len(PKFields) - 1)
FKFields = Left(FKFields, Len(FKFields) - 1)
Debug.Print "Call AddRelationship(""" & rs.Fields(0) & """, """ & FKTable & """, """ & FKFields & """, """ & PKTable & """, """ & PKFields & """)"
rs.MoveNext
Loop
Set db = Nothing
End Sub
You will need to run the output from the above against the new database, but you will also need this function:
Public Sub AddRelationship(Name As String, FKTable As String, FKFields As String, PKTable As String, PKFields As String)
Dim strSQL As String
Dim db As DAO.Database
Set db = CurrentDb()
Name = "FK_" & Replace(FKTable, " ", "") & "_" & Replace(PKTable, " ", "") 'only enable this line if there aren't multiple relationships between same 2 tables
strSQL = "ALTER TABLE [" & FKTable & "] " & _
" add constraint " & Name & " foreign key (" & FKFields & ") " & _
" references [" & PKTable & "](" & PKFields & ") "
db.Execute strSQL, dbFailOnError
Set db = Nothing
End Sub
Run the generated VBA code in a module with the above function, and it should rebuild your relationships in the new database.
Note this code is quick & dirty so might need some bug fixes for your database/data.
I created an Access database which I want to distribute to a small group. While I can always export the tables in excel and merge them/append data there, is there a way to sync the databases, maybe by using VBA?
To expound further, in one form in the database application, a sync button may exist, and onclick, a dialog box may open to look for the accdb to sync with. What ensues is that the VBA will "sync" the table (which of course is of the same structure) in question between the two accdbs.
Is this possible? Insights will be good. Thank you!
Yes, it is perfectly possible. Here are some notes on comparing two DBs and logging changes.
The procedure requires the following at the top of the module:
Dim strFileNew As String
Dim strFileOld As String
Dim strLog As String
Dim dbOld As Database
The variables might contain:
strLog = "log.txt"
strFileNew = "z:\docs\dbNew.mdb"
strFileOld = "z:\docs\dbOld.mdb"
Set dbOld = OpenDatabase(strFileOld)
Then the comparison:
Sub LogCompareDB(db As Database)
''References : Windows Script Host Object Model
'' This is set by default for a number of versions
'' : Microsoft DAO x.x Object Library
'' For 2010, the DAO library is called
'' :Microsoft Office 12.0 Access Database Engine Object Library
Dim tdf As TableDef
Dim rs0 As DAO.Recordset
Dim rs1 As DAO.Recordset
Dim fld As DAO.Field
Dim idx As Index
Dim idxPrimary As Index
Dim strIndexList As String
Dim strIndex As String
Dim strID As String
Dim strSQL As String
Dim strChanged As String
Dim blnNew As Boolean
Dim fs As New FileSystemObject
Dim ts As TextStream
Set ts = fs.CreateTextFile(strLog, True)
''For each table in the old database
''(It would probably be a good idea to check the
''new database for added tables)
For Each tdf In db.TableDefs
'' Skip system tables
If Left(tdf.Name, 4) <> "MSys" Then
strIndex = vbNullString
Set idxPrimary = Nothing
strIndexList = vbNullString
''Get the primary index and index fields
For Each idx In tdf.Indexes
If idx.Primary = True Then
Set idxPrimary = idx
For Each fld In idx.Fields
strIndex = strIndex & " AND t0.[" & fld.Name _
& "] = t1.[" & fld.Name & "]"
strIndexList = strIndexList & "," & fld.Name
Next
strIndex = Mid(strIndex, 5)
End If
Next
''There is no basis for comparison if there is no index.
''A unique index would also be a possibility, but hey, let's
''not go over the top :)
If strIndex > vbNullString Then
''Select all records from the table for both databases
strSQL = "SELECT * FROM [;DATABASE=" & strFileNew & "].[" _
& tdf.Name & "] As t0 LEFT JOIN [" _
& tdf.Name & "] As t1 ON " & strIndex
Set rs0 = db.OpenRecordset(strSQL)
''A convenient list of fields from the old database
''It would probably be a good idea to check the
''new database for added fields.
strSQL = "SELECT * FROM [;DATABASE=" & strFileOld & "].[" _
& tdf.Name & "] As t0 WHERE 1=2"
Set rs1 = db.OpenRecordset(strSQL)
Do While Not rs0.EOF
strID = vbNullString
blnNew = False
''If the index fields are null, then it is a new record
For Each fld In idxPrimary.Fields
strID = strID & fld.Name & ": " & rs0("[t0." & fld.Name & "]") & vbCrLf
If IsNull(rs0("[t1." & fld.Name & "]")) Then
blnNew = True
End If
Next
If blnNew Then
''Write to log
ts.WriteLine "NEW RECORD " & strID & vbCrLf
Else
''Not a new record, so is it a changed record?
strChanged = vbNullString
For Each fld In rs1.Fields
''No need to check index fields, because they are equal
If InStr(strIndexList, fld.Name) = 0 Then
''Add null string for purposes of comparison ''trailing
If "" & rs0("[t0." & fld.Name & "]") <> "" & rs0("[t1." & fld.Name & "]") Then
strChanged = strChanged & vbCrLf _
& fld.Name & " Is: " & Trim(rs0("[t0." & fld.Name & "]")) _
& " Was: " & Trim(rs0("[t1." & fld.Name & "]"))
End If
End If
Next
If strChanged <> vbNullString Then
''Write to log
ts.WriteLine "CHANGED RECORD " & strID
ts.WriteLine strChanged & vbCrLf
End If
End If
rs0.MoveNext
Loop
Else
ts.WriteLine "NO PRIMARY INDEX " & tdf.Name & vbCrLf
End If
End If
Next
ts.Close
FollowHyperlink strLog
End Sub
Option Compare Database
Private Sub Command4_Click()
Dim tablename1, tablename2 As String
tablename1 = Text0.Value
tablename2 = Text2.Value
'On Error GoTo Err_cmdValidateGeneralInfo_Click
Dim F As DAO.Field
Dim rs As DAO.Recordset
Dim rs1 As DAO.Recordset
Set curDB = CurrentDb()
'If Me.DateModified = Date Then
'Adds new employees to the TT_GeneralInfo table in the FTEI_PhoneBook.mdb - which is used thru out the AP databases.
' DoCmd.OpenQuery "qryEmpData_TT_General"
strsql = "Select * from " & tablename1
Set rs = curDB.OpenRecordset(strsql)
strsql1 = "Select * from " & tablename2
DoCmd.CopyObject , "Unmatched_records", acTable, tablename1
curDB.Execute "DELETE FROM Unmatched_records"
Set rs1 = curDB.OpenRecordset(strsql1)
Do Until rs.EOF
For Each F In rs.Fields
If rs.Fields(F.Name) <> rs1.Fields(F.Name) Then
'rs.Edit
strsql = "Select * into test from " & tablename1 & " where " & F.Name & " = """ & rs.Fields(F.Name) & """"
DoCmd.RunSQL strsql
If DCount(F.Name, "test") <> 0 Then
GoTo append_unmatch
'appending unmacthed records
append_unmatch:
strsql2 = "insert into Unmatched_records Select * from test"
DoCmd.RunSQL strsql2
'if record doesnt match move to next one
GoTo Nextrecord
End If
' rs.Fields(F.Name) = rs1.Fields(F.Name)
' rs.Update
End If
Next F
Nextrecord:
rs.MoveNext
rs1.MoveNext
Loop
If DCount("test", F.Name) <> 0 Then
MsgBox ("The two tables didnt match. Check table test for unmatching reocrds.")
Else
MsgBox ("Tables match!")
End If
End Sub