I'm having an issue with a VBA program I made. I want to create a program which inputs 50,000 records throughout a table (which is the Employee Table in my case), and every time I try to run it, it states an error that says "Compile Error: Duplicate declaration in current scope."
My code is as follows:
Option Compare Database
Option Explicit
Sub arrayData1()
'This subroutine will pump in 50 k records for the first two columns of EMPLOYEE table.
'Also takes in sample names, attempts to clean the data beofre its entered in the table.
'Declare variable by using keyword DIM
Dim EmployeeFNames() As Variant 'implies array. array is always declared variant datatype.
Dim EmployeeLNames() As Variant
Dim EmployeeType() As Variant
Dim num As Integer, dbs As Database, InsertRecord As Variant, num1 As Long
Dim EmployeeID As Long, EmployeeFName As String, EmployeeLName As String, EmployeeType As String, EmployeeWages As Long
'assign value to variables
Set dbs = CurrentDb() 'assign current db(Stage 2 Project)
EmployeeID = 0 'initialise value.
For num1 = 0 To 50000
EmployeeID = EmployeeID + 1 'increment by 1.
EmployeeWages = EmployeeWages + 1
' array is populated with names.
EmployeeFNames = Array("Peter", "Mary", "Frances", "Paul", "Ian", "Ron", "Nathan", "Jesse", "John", "David")
EmployeeLNames = Array("Jacobs", "Smith", "Zane", "Key", "Doe", "Patel", "Chalmers", "Simpson", "Flanders", "Skinner")
EmployeeTypes = Array("Groundskeeper", "Housekeeper", "Concierge", "Front Desk", "Chef", "F&B", "Maintenance", "Accounts", "IT", "Manager")
'Equation for random generation
'INT (upperbound - lowerbound +1) * Rnd + lowerbound) ' upper & lower bound are index values of array
num = Int((9 - 0 + 1) * Rnd + 0) ' equation generates at random a number between 0 & 9.
EmployeeFName = EmployeeFNames(num) ' name is picked at random from array based on random number.
EmployeeLName = EmployeeLNames(num)
EmployeeType = EmployeeTypes(num)
' Use SQL INSERT statement to insert record in EPLOYEE table.
InsertRecord = "INSERT INTO EMPLOYEE(EmployeeID, EmployeeFName, EmployeeLName, EmployeeType, EmployeeWages) VALUES(" _
& "'" & EmployeeID & "'" & "," & "'" & EmployeeFName & "'" & "," & "'" & EmployeeLName & "'" & "," & "'" & EmployeeType & "'" & "," & "'" & EmployeeWages & "'" & ")"
dbs.Execute InsertRecord
Debug.Print EmployeeID; EmployeeFName; EmployeeLName; EmployeeType; EmployeeWages
Next
End Sub
I would appreciate any fixes to this problem and any suggestions towards my code.
You have tried to declare (Dim) the variable EmployeeType as an array of Variant and then later you try to declare it (again) as String.
You'll need to use two different names for those two variables.
Related
I am trying to import some fields from two tables that need to be joined from SSMS. The importation process is through VBA. When importing from a singular table, my query ran fine but when I tried introducing a joined format, I received the error Run-time error -2147217900 (80040e14) Incorrect Syntax near 'dd' This piece of code is where the error gets thrown:
'The line item below is what gets highlighted and throws the error message
rsData.Open strQuery, objConn
Sub GetData_Using_VERSION_ID()
Dim strConnectionString As String, strQuery As String, strMessage As String
Dim objConn As ADODB.Connection
Dim rsData As New ADODB.Recordset
Dim varArrayReader As Variant
Dim tot_rows As Long
Dim intLBoundColumn As Long, intUBoundColumn As Long ' this variable is meant to hold the lower and upper indexes of the 1st dimension of the Array (columns)
Dim intLBoundRow As Long, intUBoundRow As Long ' this variable is meant to hold the lower and upper indexes of the 2nd dimension of the Array (rows)
Dim intLBoundColumn2 As Long, intUBoundColumn2 As Long ' this variable is meant to hold the lower and upper indexes of the 1st dimension of the Array (columns)
Dim intLBoundRow2 As Long, intUBoundRow2 As Long ' this variable is meant to hold the lower and upper indexes of the 2nd dimension of the Array (rows)
Dim intLBoundColumn3 As Long, intUBoundColumn3 As Long ' this variable is meant to hold the lower and upper indexes of the 1st dimension of the Array (columns)
Dim intLBoundRow3 As Long, intUBoundRow3 As Long ' this variable is meant to hold the lower and upper indexes of the 2nd dimension of the Array (rows)
Dim intLBoundColumn4 As Long, intUBoundColumn4 As Long ' this variable is meant to hold the lower and upper indexes of the 1st dimension of the Array (columns)
Dim intLBoundRow4 As Long, intUBoundRow4 As Long ' this variable is meant to hold the lower and upper indexes of the 2nd dimension of the Array (rows)
Dim i As Long, j As Long
Dim found As Integer
Dim VId As String
Dim ews As Excel.Worksheet
Dim sws As Excel.Worksheet
Dim lws As Excel.Worksheet
'Variable to determine if App version is found for ny_id lookup
found = 0
VId = Cells(1, 3)
Set ews = Worksheets("Employer_Data")
Set sws = Worksheets("Student_Data")
Set lws = Worksheets("Loan_Data")
'Determine if Ny_id has been found or not to set the initial total rows
'tot_rows is the starting point for the inserting of the headers and data beneath them
If Cells(2, 1) = "" Or Cells(1, 1) = "" Then
tot_rows = 3
Else
tot_rows = Range("A2").End(xlDown).Row + 3
End If
'See if valid app version id input for lookup
If VId = "" Or Not IsNumeric(VId) Then
Rows(tot_rows - 1 & ":" & Rows.Count).ClearContents
ews.Rows(tot_rows - 1 & ":" & Rows.Count).ClearContents
sws.Rows(tot_rows - 1 & ":" & Rows.Count).ClearContents
lws.Rows(tot_rows - 1 & ":" & Rows.Count).ClearContents
Cells(tot_rows - 1, 1).Value = "Bad Application_Version_ID Entered"
ews.Cells(tot_rows - 1, 1).Value = "No Application_Version_ID Entered"
sws.Cells(tot_rows - 1, 1).Value = "No Application_Version_ID Entered"
lws.Cells(tot_rows - 1, 1).Value = "No Application_Version_ID Entered"
Else
'Connection string for our Dev Database
strConnectionString = "Provider = SQLOLEDB;" _
& "Data Source=NAME REMOVED FOR DATA INTEGRITY;" _
& "Initial Catalog=NAME REMOVED FOR DATA INTEGRITY;" _
& "User ID=NAME REMOVED FOR DATA INTEGRITY;" _
& "Password=NAME REMOVED FOR DATA INTEGRITY;"
'***THIS CODE WORKS BY PULLING FIELDS FROM A SINGULAR TABLE SOURCE BUT I NEED TO PULL FIELDS FROM A JOINED TABLE
'Add/Update/Remove Fields Here
'NY_CALCULATION SQL Statement to pull data
' strQuery = ""
' strQuery = strQuery & "SELECT NY_ID, APPLICATION_VERSION_ID, grad_year, year, month, calc_year, marital_status, number_dependents, " _
' & "annual_gross_salary , qual_income, month_part_cont, monthly_payment_non_law, monthly_payment_law, month_lrap_benefit, spouse_annual_gross_salary, " _
' & "spouse_monthly_payment_ug , orig_principle_law, adjusted_orig_principle_law " _
' & "FROM [dbo].[NY_CALCULATION]" & " WHERE APPLICATION_VERSION_ID in (" & VId & ") order by application_version_id, month"
'*************************************************************
'THIS IS THE QUERY STRUCTURE THAT I NEED TO USE TO PULL THE NECESSARY FIELDS FROM SSMS INTO AN EXCEL FILE, HOWEVER AS MENTIONED I RECEIVE AN ERROR. I ASSUME THAT MAYBE I DIDN'T STRUCTURE THE QUERY PROPERLY?
strQuery = ""
strQuery = strQuery & "SELECT ah.NY_ID, ah.NEW_APPLICATION_ID, dd.GRAD_YEAR, dd.FIRST_NAME, dd.LAST_NAME, dd.MARITAL_STATUS, dd.NUMBER_DEPENDENTS, " _
& "dd.LRAP_PROGRAM, dd.CREATED_TIME " _
& "FROM [dbo].[NY_APPLICATION_HISTORY] ah" _
& "LEFT JOIN [dbo].[NY_DEMOGRAPHIC_DATA] dd" _
& "ON dd.APPLICATION_VERSION_ID = ah.NEW_APPLICATION_ID" _
& " WHERE APPLICATION_VERSION_ID in (" & VId & ")" _
& "ORDER BY ah.NEW_APPLICATION_ID"
'Execute SQL statement
Set objConn = New ADODB.Connection
objConn.Open strConnectionString
Set rsData = New ADODB.Recordset
'The line item below is what gets highlighted and throws the error message
rsData.Open strQuery, objConn
'Check to see if we were able to find data with select statement
If rsData.EOF Then
Cells(tot_rows - 1, 2).Value = "No Calculation Data found for that Application_Version_ID"
Else
I am new to VBA, so I'm having trouble understanding what is going on. I am trying to fill a table with 50,000 records with the following code:
Sub arrayData()
Dim custnames() As Variant
Dim num As Long, dbs As Database, InsertRecord As String
Dim CusSalaryId As Long, num1 As Long, EmpId As Long
Dim EmpSalary As String
Set dbs = CurrentDb()
EmpId = 0
CustSalaryId = 0
For num1 = 0 To 50000
CustSalaryId = CustSalaryId + 1
EmpId = EmpId + 1
custnames = Array("$1000", "$500", "$300", "$600")
num = Int((UBound(custnames) - LBound(custnames) + 1) * Rnd + LBound(custnames))
EmpSalary= custnames(num)
InsertRecord = "insert into SALARY (SalaryID, NetSalary, EmployeeID)
values (" & "'" & CustSalaryId & "'" & "," & "'" & EmpSalary & "'" & "," & "'" & EmpId & "'" & ")"
dbs.Execute InsertRecord
Debug.Print SalaryId; EmpSalary; EmpId;
Next
End Sub
When I run it, I get only 2 records:
Salary Table Output
I have figured it out, sorry for wasting your time! It was because of the relationships I've created as salary table was linked to the employee table which only had 2 records therefore salary table was only able to create a maximum of 2 records. I am sorry again for not double checking everything before posting.
I've created DB within Access and given Data Type "Short Text."
Now I'm trying to prompt record into this table through Visual Basic. I wrote a code so far but need help to fix an error. I'm getting the compile error:
Duplicate declaration in current scope
I can't figure it out what it is?
Option Compare Database
Sub arrayData()
Dim CustomerName() As Variant
Dim num As Integer, dbs As Database, InsertRecord As String
Dim CustomerID As Long, num1 As Long, CustomerName As String
Set dbs = CurrentDb()
CustomerID = 0
For num1 = 0 To 49999
CustomerID = CustomerID + 1
CustomerName = Array("Peter", "Mary")
CustomerAddress = Array("163 City Rd, SOUTHBANK", "65 Orange St, BENTLEIGH EAST")
CustomerPhoneAddress = Array("0416874963", "0478937534")
num = Int((200 - 0 + 1) * Rnd + 0)
CustomerName = CustomerName(num)
CustomerAddress = CustomerAddress(num)
CustomerPhoneNo = CustomerPhoneNo(num)
InsertRecord = "INSERT INTO Customers (CustomerID,CustomerName,CustomerAddress,CustomerPhoneNo) VALUES (" & "'" & CustomerID & "'" & "," & "'" & CustomerName & "'" & "," & "'" & CustomerAddress & "'" & "," & "'" & CustomerPhoneNo & "'" & ")"
dbs.Execute InsertRecord
Debug.Print CustomerID, CustomerName, CustomerAddress, CustomerPhoneNo
Next
End Sub
What can I do in this situation? Any help would be appreciated.
The language you are using is "Visual Basic for Applications" (VBA). This language is line-oriented. It menas that one statement must fit on one single line, unless you are using a line continuation character (_) preceeded by at least one whitespace.
Dim CustomerID As Long, num1 As Long, CustomerName As String, CustomerAddress _
As String, CustomerPhoneNo As String
But I would place the Long and String variables on separate lines and write:
Dim CustomerID As Long, num1 As Long
Dim CustomerName As String, CustomerAddress As String, CustomerPhoneNo As String
The second syntax error is in the InsertRecord = "INSERT INTO ... statement. same problem here. It shoul look like this:
InsertRecord = "INSERT INTO CUSTOMERS (CustomerID,CustomerName," _
& "CustomerAddress,CustomerPhoneNo) VALUES " _
& "(" & "'" & CustomerID & "'" & "," & "'" & CustomerName & "'" & "," & "'" _
& CustomerAddress & "'" & "," & "'" & CustomerPhoneNo & "'" & ")"
Also, what are the - 0 and + 0 good for in Int((200 - 0 + 1) * Rnd + 0). The expression is equivalent to Int(201 * Rnd).
After your edits it seems that you have no line continuations.
THE ERROR IS: You have 2 variables named CustomerName. Variable names must be unique:
Dim CustomerName() As Variant
Dim CustomerName As String
For instance, name the array CustomerNames:
Dim CustomerNames() As Variant
And you should indent your code. It makes it much easier to read.
Sub arrayData()
Dim CustomerName() As Variant
...
CustomerID = 0
For num1 = 0 To 10
CustomerID = CustomerID + 1
...
Debug.Print CustomerID, CustomerName, CustomerAddress, CustomerPhoneNo
Next
End Sub
I like to export data (single records) from one Access database to another one in another country. The idea is that I want to send a text file with INSERT INTO statements per email and the receiving PC just executes these INSERT INTO statements. I wrote already the code to read and execute the INSERT INTO statements in these text files.
Obviously I have to generate the INSERT INTO statements.
Here is an example.
I have the following table:
Table1
Id number
PersonName text
DoB date, can be empty
NumberOfChildern number, can be empty
I select the data like this:
SELECT Id, PersonName, DoB, NumberOfChildern FROM Table1;
What I want to generate are statements like this:
INSERT INTO Table1 (Id, PersonName, DoB, NumberOfChildern ) VALUES (1, ‘Peter’, #5-17-1990#, 1)
If all fields are always filled in then I could write one time the code and that's it. But there is a problem if a couple of fields might contain data or maybe no data.
Here are some similar but different versions of the above statement:
INSERT INTO Table1 (Id, PersonName, DoB, NumberOfChildern ) VALUES (1, ‘Peter’, #5-17-1990#, 1)
INSERT INTO Table1 (Id, PersonName, NumberOfChildern ) VALUES (1, ‘Peter’, 1)
INSERT INTO Table1 (Id, PersonName, DoB ) VALUES (1, ‘Peter’, #5-17-1990#)
INSERT INTO Table1 (Id, PersonName ) VALUES (1, ‘Peter’)
With just two fields which can contain NULL values there are already 4 different versions of this statement and with more fields it becomes more and more complicated (not really complicated but more work).
I think about writing code in VBA which analyzes the table and the records which I want to export to check which kind of fields are used (i.e. date) and then generate statements like above.
I am sure I can do this but I wonder if maybe others did this before.
I don't want to reinvent the wheel.
But searching for "generate SQL insert statements" is not really efficient.
Any ideas?
It's your lucky day. I have done this for SQL Server - with a few modifications done below it should work for Access SQL.
The key is to insert VALUES NULL, not create different statements if values are null.
The SET IDENTITY_INSERT ON/OFF probably isn't needed for Access.
Gustav has posted a generic function that can replace all Sqlify/SqlDate etc. helper functions and covers more data types.
Public Sub InsertStatementsSql(ByVal sTABLE As String)
Dim DB As DAO.Database
Dim TD As DAO.TableDef
Dim RS As DAO.Recordset
Dim fld As DAO.Field
Dim sKpl As String
Dim sStart As String
Dim sValues As String
Dim S As String
Dim v As Variant
Dim i As Long
Dim bIdentity As Boolean
Set DB = CurrentDb
Set TD = DB.TableDefs(sTABLE)
Set RS = DB.OpenRecordset(sTABLE, dbOpenSnapshot)
' Check for Autonumber/IDENTITY column
bIdentity = False
For i = 0 To TD.Fields.count - 1
If (TD.Fields(i).Attributes And dbAutoIncrField) > 0 Then
bIdentity = True
Exit For
End If
Next i
If bIdentity Then
sKpl = sKpl & "SET IDENTITY_INSERT " & sTABLE & " ON;" & vbCrLf & vbCrLf
End If
' "INSERT INTO ... VALUES " for every line
For i = 0 To TD.Fields.count - 1
sStart = StrAppend(sStart, TD.Fields(i).Name, ", ")
Next i
sStart = "INSERT INTO " & sTABLE & " (" & sStart & ") VALUES "
' One line per record
Do While Not RS.EOF
sValues = ""
For i = 0 To TD.Fields.count - 1
v = RS(i)
If IsNull(v) Then
S = "NULL"
Else
Set fld = TD.Fields(i)
Select Case fld.Type
Case dbText, dbMemo: S = Sqlify(CStr(v))
Case dbDate: S = SqlDate(CDate(v))
Case dbDouble, dbSingle: S = SqlNumber(CDbl(v))
Case Else: S = CStr(v)
End Select
End If
sValues = StrAppend(sValues, S, ", ")
Next i
' Append line to full SQL
sKpl = sKpl & vbCrLf & sStart & " (" & sValues & ");"
RS.MoveNext
Loop
RS.Close
Set TD = Nothing
If bIdentity Then
sKpl = sKpl & vbCrLf & vbCrLf & "SET IDENTITY_INSERT " & sTABLE & " OFF;" & vbCrLf
End If
Debug.Print sKpl
' see https://support.microsoft.com/en-us/kb/210216 or https://msdn.microsoft.com/en-us/library/office/ff192913.aspx
' or https://stackoverflow.com/a/25431633/3820271
'ClipBoard_SetData sKpl
End Sub
' ------------------- helper functions -----------------
' ein'string --> 'ein''string'
Public Function Sqlify(ByVal S As String) As String
S = Replace(S, "'", "''")
S = "'" & S & "'"
Sqlify = S
End Function
Public Function SqlDate(vDate As Date) As String
SqlDate = "#" & Format(vDate, "yyyy-mm-dd") & "#"
End Function
Public Function SqlNumber(num As Double) As String
SqlNumber = Replace(CStr(num), ",", ".")
End Function
Public Function StrAppend(sBase As String, sAppend As Variant, sSeparator As String) As String
If Len(sAppend) > 0 Then
If sBase = "" Then
StrAppend = Nz(sAppend, "")
Else
StrAppend = sBase & sSeparator & Nz(sAppend, "")
End If
Else
StrAppend = sBase
End If
End Function
I'm using a VBA Script to update a table in SQL, so far it works perfectly. The problem is when handling null values. Because the VBA script loops until the first column ends, some values are null in the worksheet, but they are placed as zeros in sql.
In Excel:
Name Last name Age
daniel mtz 22
jose mtz 25
John doe
Final result in SQL:
Name Last name Age
daniel mtz 22
jose mtz 25
John doe 0
Any thoughts on how I can tell the Macro or SQL to read them as null and not zero?
P.S, programming each column in sql to place null in the corresponding value is not an option, because this table will be changing constantly and I could have all columns filled, or just some, etc.
[UPDATE] Here is the code for the VBA:
Sub Macro_CargarSQL()
'VARIABLES
Dim conn As New ADODB.Connection
Dim iRowNo As Integer
'Column variables
Dim sname, slastname, sage As String
'CONECTION TO SERVER Y BD
conn.Open "Provider=SQLOLEDB;Data Source=Termxgesvsql07\vfsitesamn;Initial Catalog=DW_PLCO;Integrated Security=SSPI;"
'Import into SQL
With Sheets("test")
'Start row 2
iRowNo = 2
'Delete previous
conn.Execute "delete from table"
'Loop for insert
Do Until .Cells(iRowNo, 1) = ""
sname = .Cells(iRowNo, 1)
slastname = .Cells(iRowNo, 2)
sage = .Cells(iRowNo, 3)
conn.Execute "insert into dbo.table (name, lastname,age ) values ('" & sname & "', '" & slastname & "', '" & sage & "')"
iRowNo = iRowNo + 1
Loop
End With
conn.Close
Set conn = Nothing
End Sub
One way I've done this is to create two SQL strings and do checks on the actually values.
You can do this as follows (generally this is a lot easier if you have an array as you can write an iteration through your values/fieldnames).
Do Until .Cells(iRowNo, 1) = ""
sName = .Cells(iRowNo, 1)
slastname = .Cells(iRowNo, 2)
sage = .Cells(iRowNo, 3)
Dim sqlStrStart As String
Dim sqlStrValues As String
Dim sqlStrFull As String
sqlStrStart = "insert into dbo.table ("
sqlStrValues = " values ("
'build string dynamically (generally I do this using parameters, but this will work)
If sName <> "" Then
sqlStrStart = sqlStrStart + "name,"
sqlStrValues = sqlStrValues + sName & ","
End If
If slastname <> "" Then
sqlStrStart = sqlStrStart + "lastname,"
sqlStrValues = sqlStrValues + slastname & ","
End If
If sName <> "" Then
sqlStrStart = sqlStrStart + "age,"
sqlStrValues = sqlStrValues + sage & ","
End If
'remove last comma
sqlStrStart = Left(sqlStrStart, Len(sqlStrStart) - 1)
sqlStrValues = Left(sqlStrValues, Len(sqlStrValues) - 1)
'close parenthesis
sqlStrStart = sqlStrStart & ")"
sqlStrValues = sqlStrValues & ")"
'combine
sqlStrFull = sqlStrStart + sqlStrValues + ";"
conn.Execute sqlStrFull
iRowNo = iRowNo + 1
Loop
The best way is to create a function that inspects whether a cell value is empty or not. When empty, output should be "null", but when not, enclose the value in between single quotes.
This function can also be used so you can escape values that has single quote in it (such as "O'Brien"). Otherwise, in your current code, you'll encounter a SQL error.
Here's the function:
Function toSQL(s)
If s = "" Then toSQL = "null" Else toSQL = "'" & Replace(s, "'", "''") & "'"
End Function
And here's the replacement Insert statement:
conn.Execute "insert into dbo.table (name, lastname,age ) values (" & toSQL(sname) & ", " & toSQL(slastname) & ", " & toSQL(sage) & ")"
If you consistently call the toSQL function, and also consistently define the column in the SQL database as nullable, you'll be set. If the data type is numeric, you may not want to call toSQL though.
Use this when setting a null value in Excel VBA, and pass that to the SQL parameter's value.
DBNull.Value