Ok so I'm trying to writing VBA code to automate as much as possible. What I need it to do is read from a field in a table and if it meets the conditions than it copy that to a new table. It's for rotation purposes. If CurrentDate equals NextDateOut than whatever value of that item I want to go to a certain table but also want to update values in the current table. NextDateOut will be the new LastDateOut value in the table and NextDateIn will be 10 days from NextDateIn and NextDateOut will be 10 days from then. I can write the math logic of this it's just the comparing my values from my table to my constant which right now is CurrentDate and updating the values and writing the values to a certain table when the conditions meet.
Here's the code so far and there's a lot of mistakes trying to figure it out as well.
Option Explicit
Sub Run()
'Declarations for grabbing data from the database for the VBA
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim strSQL As String
'Open connection to current Access database
Set db = CurrentDb()
'Declarations for variables to deal with dates
Dim CurrentDate As Date
Dim NextDateOut As Date
Dim NextDateIn As Date
Dim LastDateOut As Date
Dim LastDateIn As Date
'Setting a consistant value, technically not a constant value since there's no "const"
CurrentDate = Date
'Will take this out eventually
MsgBox (CurrentDate)
strSQL = "SELECT Next Date Out FROM Tapes Where Next Date Out = CurrentDate"
Set rst = db.OpenRecordset(strSQL, dbOpenDynaset)
With rst
If .RecorCount > 0 Then
.MoveFirst
.Edit
!Next Date Out = (CurrentDate+20)
.Update
End If
End With
End Sub
Thanks in ADVANCE!!! I'm making progress but hitting walls on the way. THANKS AGAIN!!!
I think you can solve this directly with queries.
Let's split this problem into steps:
If NextDateOut (a field in your table) equals currentDate (a variable in your code), then:
You need to move all records for which the condition is true to a new table
For the records that remain in the table, you need to update LastDateOut to currentDate, nextDateIn to currentDate + 10 and nextDateOut to currentDate + 20
If this is correct, you can try this:
dim strSQL as String
dim currentDate as Date
...
' Step 1: Copy the records to a new table '
strSQL = "insert into otherTable " & _
"select * from tapes " & _
"where [nextDateOut]=" & CDbl(currentDate)
doCmd.runSQL strSQL
' Step 2: Delete the records just copied '
strSQL = "delete from tapes where [nextDateOut]=" & CDbl(currentDate)
doCmd.runSQL strSQL
' Step 3: Update the dates in ALL the records remaining the "tapes" table '
strSQL = "update tapes " & _
"set [lastDateOut]=" & CDbl(currentDate) & ", " & _
"set [nextDateIn]=" & CDbl(currentDate + 10) & ", " & _
"set [nextDateOut]=" & CDbl(currentDate + 20)
doCmd.runSQL strSQL
...
Note: I use CDbl(currentDate) to avoid problems with Date formats (MS Access stores dates as double values, with the integer part representing days and the decimal part representing fractions of days)
Hope this helps you
Related
I use ConcatRelated function (made by Allen Browne) to merge string values from several rows in the MainTable, grouped by CategoryNumber:
ConcatRelated("[TextField]", "[MainTable]", "[CategoryNumber] = " & [CategoryNumber])
In that scenario, function works perfectly. However, I need to merge rows with only some of the categories. I store these selected categories in the Table2. I made Query1 that connects Table2 with MainTable through Tag field.
SELECT MainTable.CategoryNumber, MainTable.TextField
FROM Table2 INNER JOIN MainTable ON Table2.Tag = MainTable.ConnectedTag;
Now I have only selected rows I want to use with Concat function. I try to use it in the same way as previous:
ConcatRelated("[TextField]", "[Query1]", "[CategoryNumber] = " & [CategoryNumber])
Then occurs Error 3061: too few parameters. Expected 1.
I also try to use Concat as the event procedure in the form.
In result i see Run-time error '2465' can't find the field '|1'
ConcatRelated module looks like this and, as mentioned before, it works just fine in many other cases:
Public Function ConcatRelated(strField As String, _
strTable As String, _
Optional strWhere As String, _
Optional strOrderBy As String, _
Optional strSeparator = ", ") As Variant
On Error GoTo Err_Handler
Dim rs As DAO.Recordset
Dim rsMV As DAO.Recordset
Dim strSQL As String
Dim strOut As String
Dim lngLen As Long
Dim bIsMultiValue As Boolean
ConcatRelated = Null
strSQL = "SELECT " & strField & " FROM " & strTable
If strWhere <> vbNullString Then
strSQL = strSQL & " WHERE " & strWhere
End If
If strOrderBy <> vbNullString Then
strSQL = strSQL & " ORDER BY " & strOrderBy
End If
Set rs = DBEngine(0)(0).OpenRecordset(strSQL, dbOpenDynaset)
bIsMultiValue = (rs(0).Type > 100)
Do While Not rs.EOF
If bIsMultiValue Then
'For multi-valued field, loop through the values
Set rsMV = rs(0).Value
Do While Not rsMV.EOF
If Not IsNull(rsMV(0)) Then
strOut = strOut & rsMV(0) & strSeparator
End If
rsMV.MoveNext
Loop
Set rsMV = Nothing
ElseIf Not IsNull(rs(0)) Then
strOut = strOut & rs(0) & strSeparator
End If
rs.MoveNext
Loop
rs.Close
lngLen = Len(strOut) - Len(strSeparator)
If lngLen > 0 Then
ConcatRelated = Left(strOut, lngLen)
End If
Exit_Handler:
Set rsMV = Nothing
Set rs = Nothing
Exit Function
Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "ConcatRelated()"
Resume Exit_Handler
End Function
I use Access 2013 with SQL server. What I do wrong?
I have figured this out. ConcatRelated doesn't want to read my query, so I decided to feed function with temporary table, where I will put data from that query. Here is the example workaround:
Build temporary table:
Create table with the same structure as your query.
Change your query type to Append Query (don't use Concat function yet - you will build another query for that).
Set where each column of your Append Query should send data to your temporary table.
Make sure your temporary table has accurate data:
If you use ConcatRelated in specific form, add VBA to this form's opening event to delete all records from temporary table (something like this:
DoCmd.RunSQL ("DELETE * FROM TempTable;")
Now your temp table is clear, so you may execute your Append Query (in the same form’s event procedure), to fulfill temp table with proper data:
DoCmd.OpenQuery "YourAppendQuery"
Run another query (the one with ConcatRealted function), but this time refer to your temp table. In above case, it would look like that:
ConcatRelated("[TextField]", "[TempTable]", "[CategoryNumber] = " & [CategoryNumber])
Maybe it's not a beautiful solution, but it works for me and allows me to go further with my project.
I learned a couple of weeks ago how to update an Excel file via ADO. At that time the value was already given before changing it.
Now I want to add the procedure of reading the current value in the same cell and assign the value to a variable before changing it!
The current procedure looks as follows:
Public Sub ChangeNum()
Dim con As ADODB.Connection, rec As ADODB.Recordset
Dim sqlstr As String, datasource As String
Set con = New ADODB.Connection: Set rec = New ADODB.Recordset
datasource = "D:\DropBox\TraderShare\TraderNum.xlsx"
Dim sconnect As String
sconnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & datasource & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
con.Open sconnect
sqlstr = "UPDATE [Sheet1$] SET [Number] = """ & gsvDocNum & """ WHERE [ID] = """ & svNumRng & """"
rec.Open sqlstr, con ', adOpenUnspecified, adLockUnspecified 'adLockOptimistic , adOpenStatic, adLockReadOnly
con.Close
Set rec = Nothing: Set con = Nothing
End Sub
gsvDocNum is a global string variable declared in the beginning of the initial startup routine, hence after reading the current value into the variable, the UPDATE one will write gsvDocNum + 1 to the file.
svNumRng is one of the following named ranges, PNum, SNum, TNum or INum declared in the beginning of the main routine and determined which one to look for in an earlier stage (if it’s an Purchase, SalesOrder, TradeOrder or an Invoice).
I’m not so familiar with ADO and SQL strings and I can’t find the proper syntax for SELECT for reading the current cell value and assign it to a variable before changing it with the UPDATE.
Grateful for any help!
OK, the background as follows: We have an administrative program I’ve written myself in Excel vba for registering purchases, orders and invoices, etc. It works pretty well for our requirements but has one issue, keeping order numbers synced between the users! We are 3 users using the program locally, each one registering orders and such, but we share the serial number file via a shared DropBox folder. I have the idea that using ADO/SQL without opening the Excel file would be faster than open, change and save the file in Excel. The reason is of course to minimize the time updating the file thus the delay before syncing to the cloud Dropfox location and to the other users computers is minimized. It’s a simple 2 column Excel file, TraderNum.xlsx:
ID Number
PNum 16000
SNum 16000
TNum 16132
INum 16173
I learned a couple of weeks ago how to change one of the numbers from Excel without opening the file using ADO/SQL, (see above). But I discovered that a constant update of the Excel link to a closed file for having the current number available before changing it doesn’t work as expected. Accordingly I want to use ADO/SQL also to read/assign the specific current number to a variable in the Excel procedure, before changing it with the ADO/SQL procedure above.
So somewhere between the 2 commands, rec.Open sconnect and con.Close there should be a SQL-string similar to:
sqlread = "SELECT """ & DocNumOld & """ = [Number] FROM [Sheet1$] Where [ID] = """ & svNumRng & """"
where the DocNumOld variable is assigned the current number from the chosen ID variable svNumRng.
Then the DocNumNew variable is and assigned with the DocNumOld variable incremented with 1 followed by the
sqlUpdate sequence. It should look similar to the following:
Public Sub ChangeNum()
Dim con As ADODB.Connection, rec As ADODB.Recordset
Dim sqlRead as String, sqlUpdate As String, datasource As String, sconnect As String
Set con = New ADODB.Connection: Set rec = New ADODB.Recordset
datasource = "D:\DropBox\TraderShare\TraderNum.xlsx"
sconnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & datasource & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
con.Open sconnect
sqlRead = "SELECT """ & DocNumOld & """ = [Number] FROM [Sheet1$] Where [ID] = """ & svNumRng & """"
sqlUpdate = "UPDATE [Sheet1$] SET [Number] = """ & DocNumNew & """ WHERE [ID] = """ & svNumRng & """"
rec.Open ???????, con
????? sqlRead
DocNumNew = DocNumOld + 1
UNION
????? sqlUpdate
con.Close
Set rec = Nothing: Set con = Nothing
End Sub
Can you solve this, please?
Can anyone give me a solution to how to use ADO/SQL also to read/assign one specific current number to a variable in an Excel procedure, before changing it with the ADO/SQL procedure?
I am concerned I don't understand your question, because the resulting comments don't make sense to me.
To restate your problem: you need to know the value of some cell, and be able to feed it into your code.
You can already connect to a worksheet with SQL, you already know what SELECT statements are, and you probably already know how to run them. Humor me.
sqlRead = "SELECT * FROM [Sheet1$A12:F48]"
Set rec = con.Execute(sqlRead)
Now you have a recordset rec that contains the whole table. Say you wanted to put every value of the entire table in your immediate window:
Do While Not rec.EOF
For i = 0 To rec.Fields.Count - 1
Debug.Print rec.Fields(i).Name, rec.Fields(i).Value
Next
rec.MoveNext
Loop
Don't forget to close it, and I suggest using a second variable name anyway as the name of the recordset for the update statement.
rec.Close
Say you knew the cell would always be in the 3rd row, 8th column of the table you are selecting from, you might:
For j = 0 to myRowNum-1 'you have set myRowNum equal to 3 earlier'
rec.MoveNext
Next
myOldCellValue = rec.Fields(myColNum-1).value 'you have set myColNum to 8 earlier'
rec.Close
Now, say you don't know exactly which row you will find myOldCellValue, but you know it will be found in the 4th column of the row that has the unique [ID] 1234, you might:
sqlRead = "SELECT * FROM [Sheet1$A12:F48] Where [ID] = """ & myIDNum & """" 'you have set myIDNum to 1234 earlier
Set rec = con.Execute(sqlRead)
myOldCellValue = rec.Fields(myColNum-1).value 'you have set myColNum to 4 earlier'
rec.Close
Say you wanted to UPDATE every row that had that value (I don't read that you, but for completeness), you might:
sqlUpdate="UPDATE [Sheet1$] SET [Number] = """ & DocNumNew & """ WHERE [DocNum] = """ & myOldCellValue & """"
I have quite a conundrum which I have been trying to troubleshoot. I have a stored procedure in a MySql database, which I call through an Excel VBA application. The VBA application passes the recordset into an Array, and then I use a For Loop to place each of the items in the Array onto a worksheet.
Here's the problem: two of the values in the recordset keep coming back blank in Excel. Oddly, the two are in the middle of the Array, not the beginning or end. However, if I call the stored procedure through another query program such as HeidiSql, I receive ALL values back. I'm at a loss as to why I'm not receiving all of the values through Excel... or why the Array isn't receiving them all, at any rate.
Thanks in advance for your help.
Here is my code:
Sub StartHereFlexFunderCust()
On Error GoTo ErrorHandler
Dim Password As String
Dim SQLStr As String
'OMIT Dim Cn statement. Cn stands for Database Connection
Dim Server_Name As String
Dim User_ID As String
Dim Database_Name As String
Dim custID As String
Dim myArray()
'OMIT Dim rs statement. rs stands for Database Recordset and is the Recordset of what is returned
Set RS = CreateObject("ADODB.Recordset")
Server_Name = Range("O10").Value
Database_Name = Range("O11").Value ' Name of database
'id user or username. We need to write code to insert the current user into this variable (Application.Username) if possible. But they may not be consistent across all machines.
'For example mine is "Ryan Willging" and we would have to shorten it to rwillging but others may be rwillging.
'This is important because if we do not do this all queries will come from the same person and that is not good for debugging.
User_ID = Range("O12").Value
Password = Range("O13").Value
custID = Range("C4").Value 'Deal Number from Start here that we are passing into the stored procedure
'This is the storedprocedure call and it passes in the value of the DealId to the Stored Procedure
SQLStr = "call flexFundByCustomer(" + custID + ")"
Set cn = CreateObject("ADODB.Connection") 'NEW STATEMENT
'This statement takes the variables from the checklist and passes them into a connection string
cn.Open "Driver={MySQL ODBC 5.1 Driver};Server=" & _
Server_Name & ";Database=" & Database_Name & _
";Uid=" & User_ID & ";Pwd=" & Password & ";"
'This statement queries the database using the SQL string and the connection string.
'The adOpenStatic variable returns a static copy of a set of records that you can use to find data or generate reports. There are other variables that
'could be used but I think this one will suffice.
RS.Open SQLStr, cn, adOpenForwardOnly
Debug.Print msg 'or MsgBox msg
'Take all of the info from the queries and put them into the spreadsheet
myArray = RS.getrows()
Dim Fld_Name As String
Dim Val_of_Field As String
Dim starthere As Worksheet
Fld_Name = UBound(myArray, 1)
Val_of_Field = UBound(myArray, 2)
Set starthere = ThisWorkbook.Sheets("Start Here")
MsgBox "No error yet defined Start Here!"
'This little loop works well to dump the recordset into excel. We can then map the correct fields 'k inputs the headers and R inputs the rows returned in the Recordset
For K = 0 To Fld_Name ' By using a For loop the data is inputed into excel one row at a time
starthere.Range("U4").Offset(0, K).Value = RS.fields(K).Name
For R = 0 To Val_of_Field
starthere.Range("U4").Offset(R + 1, K).Value = myArray(K, R)
Next
Next
RS.Close
Set RS = Nothing
cn.Close
Set cn = Nothing
ErrorHandler:
MsgBox "There's been an error!"
Exit Sub
End Sub
Consider using Range.CopyFromRecordset method to avoid any use of arrays. Or if memory does not allow, use a Do While Loop across Recordset columns:
' COLUMN HEADERS
For i = 1 To RS.Fields.Count
starthere.("Results").Range("U4").Offset(0, i) = RS.Fields(i - 1).Name
Next i
' DATA ROWS
' COPYFROMRECORDSET APPROACH
starthere.Range("U5").CopyFromRecordset RS
' DO WHILE LOOP APPROACH
starthere.Activate
starthere.Range("U5").Activate
row = 5
Do While Not RS.EOF
For i = 0 To RS.Fields.Count - 1
ActiveCell.Offset(0, i) = RS.Fields(i)
Next i
row = row + 1
ActiveCell.Offset(row, 21)
RS.MoveNext
Loop
As for the values returning empty that may be a MySQL and Excel incompatibility of data types. For instance, you may have a table field set to MySQL's maximum decimal (65, 30) which denotes max digits of 65 and max 30 decimal points which cannot be reflected on a spreadsheet. Current precision limit of a cell value is 15 decimal points.
Alternatively, you may have a VARCHAR(65535) which is the 65,535 byte limit or the open-ended TEXT column of no limit that also cannot be displayed on spreadsheet. Current limit of characters in one cell is 32,767.
Try modifiying column to a smaller type:
ALTER TABLE `tableName` MODIFY COLUMN `largenumberfield` DECIMAL(10,7);
ALTER TABLE `tableName` MODIFY COLUMN `largetextfield` VARCHAR(255);
Why the other programs such as HeidiSQL retrieve values? It might be due to their internal conversion features forcing data values into a specific format (i.e., removing whitespaces, truncating values) which then renders adequately in Excel.
I am creating a simple spreadsheet which takes an array of IDs from worksheet "input", queries an Oracle database asking for only the records which match the IDs in the array and outputs the results to worksheet "output".
So far, my VBA will work if my array only contains a single ID (by specifying a single cell range), and everything completes with the desired output from the Oracle database appearing in worksheet "output". Good times.
The problem I am having now is that I want to specify a range of IDs (anything up to around 5000) in worksheet "input" to include in my array and pass that array to the Oracle database to return data for each ID it finds (I am not expecting all IDs to exist). Whenever I try this I seem to get "Error 13 Type Mismatch" errors... Bad times.
My VBA code is:
Dim OracleConnection As ADODB.Connection
Dim MosaicRecordSet As ADODB.RecordSet
Dim SQLQuery As String
Dim DBConnect As String
Dim count As String
Dim strbody As String
Dim Exclude As String
Dim i As Integer
Dim Rec As RecordSet
Dim InputIDs As Variant
Set OracleConnection = New ADODB.Connection
DBConnect = "Provider=msdaora;Data Source=MOSREP;User ID=***;Password=***;"
OracleConnection.Open DBConnect
' Clear Output Sheet Down
Sheets("Output").Select
Range("A2:F10000").Clear
' Set Input Range
Sheets("Input").Columns("A:A").NumberFormat = "0"
InputIDs = Sheets("Input").Range("A2:A10").Value
' SQL Query
SQLQuery = "select DMP.PERSON_ID, DMP.FULL_NAME, DMP.DATE_OF_BIRTH, DMA.ADDRESS, DMA.ADDRESS_TYPE, DMA.IS_DISPLAY_ADDRESS " & _
"from DM_PERSONS DMP " & _
"join DM_ADDRESSES DMA " & _
"on DMA.PERSON_ID=DMP.PERSON_ID " & _
"where DMP.PERSON_ID in (" & InputIDs & ")"
Set MosaicRecordSet = OracleConnection.Execute(SQLQuery)
Sheets("Output").Range("A2").CopyFromRecordset MosaicRecordSet
' Change DOB Format
Sheets("Output").Columns("C:C").NumberFormat = "dd/mm/yyyy"
' Set Left Alignment
Sheets("Output").Columns("A:Z").HorizontalAlignment = xlHAlignLeft
Range("A1").Select
OracleConnection.Close
Set MosaicRecordSet = Nothing
Set OracleConnection = Nothing
ActiveWorkbook.Save
Can anyone shed light on what I am missing? I have attempted to resolve the Type Mismatch issue by setting the 'numberformat' on the column in worksheet "input" to "0" but that didn't help. I also thought that I might have to have a loop to iterate through each record, but I haven't got to that stage yet because of this Type Mismatch thing...
Thank you everyone for your help in advance!
Regards
Matt
The ID's need to be comma delimited
InputIDs = getIDs( Sheets("Input").Range("A2:A10") )
Function getIDs(rng As Range)
Dim c As Range
Dim s As String
For Each c In rng
s = s & c.Value & ","
Next
getIDs = Left(s, Len(s) - 1)
End Function
I need some help with some VBA for Access.
I have a table "Client_Table" with 100 rows of data. I have another table "SalesRep_Table" where I have 10 distinct Sales Rep ID numbers (such as: AA1111, and so on).
My goal is to run a procedure that takes the first ID record "AA1111" and places it in the appropriate column on the Clients table named "AssignedSalesRepID" for the first 10 rows, then the next ID number in the SalesRep_Table gets inserted into the next 10 cells in the Clients table, and the process repeats through a loop until all 10 IDs are now in 10 rows each to fill the 100 rows of data in the Clients table.
I went about it by creating two recordsets and trying a loop through SQL Update. However I end up with all 100 records containing just the last Sales Rep ID 100 times repeating. Can you take a look at my code and let me know where it needs to be fixed?
Public Sub Command01_Click()
Dim strSQL
Dim ClientsTableQuery, SalesRepList
Dim DataB as Database
Dim ClientQD as QueryDef
Dim SalesQD as QueryDef
Dim rstClient as Recordset
Dim rstSalesRep as Recordset
ClientTableQuery = "Clients"
SalesTableQuery = "SalesRepList"
'Creates a recordset with 100 client records named "Clients"
strSQL = "Select * from Client_Table"
Set DataB = CurrentDB()
Set ClientQD.CreateQueryDef(ClientTableQuery, strSQL)
Set rstClient = DataB.OpenRecordset(ClientTableQuery)
'Creates a recordset with 10 sales rep records named "SalesRepList"
strSQL = "Select SalesRepID from SalesRep_Table"
Set DataB = CurrentDB()
Set SalesQD.CreateQueryDef(SalesTableQuery, strSQL)
Set rstSalesRep = DataB.OpenRecordset(SalesTableQuery)
rstSalesRep.MoveFirst
rstClient.MoveFirst
Do Until rstSalesRep.EOF = True
'SQL Query to update the top 10 cells in the "Assigned Sales Rep ID" column in the
Clients recordset with the Sales Rep ID from the SalesRepList recordset
strSQL = "Update Clients, SalesRepList SET Clients.AssignedSalesRepID =
SalesRepList.SalesRepID where Clients.ClientIDNumber in (Select Top 10
Clients.ClientIDNumber FROM Clents where Clients.AssignedSalesRepID is Null)"
DoCmd.RunSQL (strSQL)
rstSalesRep.MoveNext
Loop
MsgBox "Finished Looping"
rstSalesRep.Close
End Sub
I hate to be the one to tell you this, but you should reconsider using SQL to do this update. I see that you have already written a lot of code and might feel like if you switch back to SQL that you will then have wasted all this vb code. I have felt like that myself in times past. But you can solve this problem with SQL with an order of magnitude less code(or nearly so).
Steps for SQL solution:
Sequence rows in both sets
mod A set sequence by B set sequence max
update A set on mod = b seq
You are making a Join call in your query, without defining how those 2 tables are being joined. You are not mentioning anywhere, which record of the rstSalesRep recordset you wish to set the assignedSalesRepId to.
Also I would reduce all your code down to the following:
Dim strSQL
Dim DataB As Database
Dim rstSalesRep As Recordset
Set DataB = CurrentDb()
Set rstSalesRep = DataB.OpenRecordset("Select SalesRepID from SalesRep_Table ")
Do Until rstSalesRep.EOF = True
strSQL = "Update Client_Table, SalesRep_Table SET Client_Table.AssignedSalesRepID = SalesRep_Table.SalesRepID " & _
"where Client_Table.ClientIDNumber in (Select Top 2 Client_Table.ClientIDNumber FROM Client_Table where Client_Table.AssignedSalesRepID is Null)" & _
" and SalesRep_Table.SalesRepID = '" & rstSalesRep("SalesRepID") & "'"
DoCmd.RunSQL (strSQL)
rstSalesRep.MoveNext
Loop
MsgBox "Finished Looping"
rstSalesRep.Close