Retrieve SQL Data and post to Database 2

[aspag]

I have been getting Syntax error in INSERT INTO STATEMENT.

TRIED INPUTTING DIFFERENT STATEMENT. WAS UNABLE TO FIND ERROR.

NEW AT VB

THANKS IN ADVANCE.



PleasePrivate Sub cmdCreate_Click()
If CreateAccessDatabase(txtDatabaseName.Text) = False Then
MsgBox ("Database Created")
Else
MsgBox ("Database Created Failed")
End If
End Sub
'------------------------------------------------
'Set the database filename
Private Sub cmdDBName_Click()
Dim DBfile_name As String
DBfile_name = "U:\PP\2005"
If Right$(DBfile_name, 1) <> "\" Then DBfile_name = DBfile_name & "\"
DBfile_name = DBfile_name & txtPP & _
cboCounty.List(cboCounty.ListIndex) & _
cboQrt.List(cboQrt.ListIndex) & _
cboYear.List(cboYear.ListIndex) & _
".mdb"
txtDatabaseName.Text = DBfile_name
End Sub
'------------------------------------------------
Public Function CreateAccessDatabase(ByVal DatabaseFullPath As String) As Boolean
Dim bAns As Boolean
Dim cat As ADOX.Catalog
Dim tbl As ADOX.Table
Dim con As ADODB.Connection
Dim sql As String

Set cat = New ADOX.Catalog
Set tbl = New ADOX.Table

' Delete the database if it already exists.
On Error Resume Next
Kill DatabaseFullPath
On Error GoTo 0

' Create the new database.
cat.Create _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & DatabaseFullPath & ";"

' Connect to the database.
Set con = cat.ActiveConnection

bAns = True

' Create a new table.
tbl.Name = "PPR"
tbl.Columns.Append "CC", adVarWChar, 2
tbl.Columns.Append "PT", adVarWChar, 2
tbl.Columns.Append "PRO", adVarWChar, 9
tbl.Columns.Append "Name", adVarWChar, 50
tbl.Columns.Append "Address - Line 1", adVarWChar, 30
tbl.Columns.Append "Address - Line 2", adVarWChar, 30

cat.Tables.Append tbl

' Insert records.
'connect to sql

sql = "select * from " & _
"ppr_rpt1_bu"

'Set oCn = fncSetObjConnRpt
'Set oRsSql = fncSetRSOpen(fncSetObjConnRpt, sql)

con.Execute "INSERT INTO Prescriber" & oRsSql

' Close the database connection.
con.Close

SADOCLOSE OCN, ORS

Set con = Nothing
Set tbl = Nothing
Set cat = Nothing

bAns = False
End Function
'------------------------------------------------
Public Property Get sConnectToDBRpt() As String
Dim strConnect As String 'DB Connection string
strConnect = "Driver={SQL SERVER};" & _
"Server=NEW_server;" & _
"DATABASE=DB_server;" & _
"TRUSTED_CONNECTION=yes;"
sConnectToDBRpt = strConnect
End Property
'------------------------------------------------
Public Function fncSetObjConnRpt()
On Error Resume Next
Dim objCn As Object 'as ADODB.Connection
Set objCn = CreateObject("ADODB.Connection")
objCn.ConnectionString = sConnectToDBRpt
objCn.CommandTimeout = 30
objCn.CursorLocation = adUseClient '=3 AdUseServer=2
objCn.Open
If Err.Number <> 0 Then
Set objCn = Nothing 'return invalid connection object
MsgBox "Mistake on connecting: " & Err.Description
Err.Clear
End If
Set fncSetObjConnRpt = objCn
End Function
'------------------------------------------------
Public Function fncSetRSOpen(sConnRS As String, sSqlRS As String)
On Error Resume Next
Dim objRS As Object 'as ADODB.Connection
Set objRS = CreateObject("ADODB.Recordset")
objRS.CursorLocation = adUseClient '3
objRS.Open sSqlRS, sConnRS, 0, 1
If Err.Number <> 0 Then
Set objRS = Nothing
MsgBox "Not a recordset!" & Err.Description
Err.Clear
End If
Set fncSetRSOpen = objRS
End Function
'------------------------------------------------------------------
' Close Connection and Recordset
Public Sub sConnClose(objCn)
On Error Resume Next
objCn.Close
Set objCn = Nothing
Err.Clear
End Sub
'------------------------------------------------------------------
Public Sub sRSClose(objRS)
On Error Resume Next
objRS.Close
Set objRS = Nothing
Err.Clear
End Sub
'------------------------------------------------------------------
Public Sub sADOClose(objCn, objRS)
Call sConnClose(objCn)
Call sRSClose(objRS)
End Sub
'------------------------------

Thanks.

 

[gmmastros]

You need to specify the fields and values.
Ex.
Insert Into TableName(Field1, Field2) Values(Val1, Val2)

Or...

Insert Into TableName(Field1, Field2)
Select Field1, Field2
From SomeOtherTable
Where SomeField = SomeValue

In your case, I assume this is where you are having a problem

sql = "select * from ppr_rpt1_bu"

'Set oCn = fncSetObjConnRpt
'Set oRsSql = fncSetRSOpen(fncSetObjConnRpt, sql)

con.Execute "INSERT INTO Prescriber" & oRsSql

If your intention is to make a 'copy' of the ppr_rpt1_bu table (calling it Prescriber), then you may want to execute the following query instead.

Select * Into Prescriber From ppr_rpt1_bu

This will copy the table structure of ppr_rpt1_bu in to a new table that will be created call Prescriber and it will copy all the data from ppr_rpt1_bu in to the prescriber table. If the Prescriber table already exists, you will get an error.




-George

Strong and bitter words indicate a weak cause. - Fortune cookie wisdom

 

[ddiamond]

Your problem is you are trying to concatenate a string with a recordset. They are incompatible data types. For what you are trying to do, the recordset is not really needed. You could simply execute the following sql:

con.Execute "INSERT INTO Prescriber SELECT * from ppr_rpt1_bu"

This assumes that both prescriber and ppr_rpt1_bu have the same table structure.

 

[ddiamond]

George,

Sorry for the duplication. I didn't realize you had already replied. It was a timing issue.

- Dan

 

[aspag]

Thanks you for you the quick response.

Insert into was changed and worked

Dim sql as string
sql = "insert into Prescriber select * from " & _
"[ODBC;Driver=SQL Server; " & _
"SERVER=NEWPASQL1;DATABASE=DBRPT;" & _
"TRUSTED_CONNECTION=yes;]." & _
"ppr_rpt1_bu"

con.execute sql


but when I changed it to provide selected fields from various tables it status it is type mismatch.

This qry ran in sql extracted all data.

Please can you check insert statement once again.

Public Function CreateAccessDatabase(ByVal DatabaseFullPath As String) As Boolean
Dim bAns As Boolean
Dim cat As ADOX.Catalog
Dim tbl As ADOX.Table
Dim con As ADODB.Connection

Set cat = New ADOX.Catalog
Set tbl = New ADOX.Table

' Delete the database if it already exists.
On Error Resume Next
Kill DatabaseFullPath
On Error GoTo 0

' Create the new database.
cat.Create _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & DatabaseFullPath & ";"

' Connect to the database.
Set con = cat.ActiveConnection

bAns = True

' Create a new table.
tbl.Name = "Prescriber"
tbl.Columns.Append "CC", adVarWChar, 2
tbl.Columns.Append "PT", adVarWChar, 2
tbl.Columns.Append "PROMISe Prov", adVarWChar, 9
tbl.Columns.Append "Provider Name", adVarWChar, 50
tbl.Columns.Append "Address - Line 1", adVarWChar, 30
tbl.Columns.Append "Address - Line 2", adVarWChar, 30
tbl.Columns.Append "City", adVarWChar, 18
tbl.Columns.Append "State", adVarWChar, 2
tbl.Columns.Append "Zip Code", adVarWChar, 5
tbl.Columns.Append "Phone #", adVarWChar, 14
tbl.Columns.Append "PP Name", adVarWChar, 30
tbl.Columns.Append "PL #", adVarWChar, 10
tbl.Columns.Append "DEA #", adVarWChar, 9

cat.Tables.Append tbl

' Insert records.

Dim strsql As String
strsql = "insert into Prescriber select distinct ppr_prov_cnty.Provider_Cnty as CC ,ppr_pt.ProviderType as PT ,ppr_mpi.MPI as [PROMISe Prov] " & _
strsql = strsql & " ,ppr_provider.ProviderName as [Provider Name] ,ppr_provider.add1 as [Address - Line 1] ,ppr_provider.add2 as [Address - Line 2]" & _
strsql = strsql & " ,ppr_provider.City" & _
strsql = strsql & " ,ppr_provider.State" & _
strsql = strsql & " ,ppr_provider.zip as [Zip Code]" & _
strsql = strsql & " ,ppr_provider.phone as [Phone #]" & _
strsql = strsql & " ,ppr_prescriber.Prescribername as [PP Name]" & _
strsql = strsql & " ,ppr_prescriber.Lic as [PL #]" & _
strsql = strsql & " ,ppr_prescriber.dea AS [DEA #] from " & _
strsql = strsql & " [ODBC;Driver=SQL Server;SERVER=NEWPASQL1;DATABASE=DBRPT;TRUSTED_CONNECTION=yes;]." & _
strsql = strsql & " ppr_record" & _
strsql = strsql & " inner join ppr_prov_cnty on ppr_record.provcntyid=ppr_prov_cnty.provcntyid" & _
strsql = strsql & " inner join ppr_pt on ppr_record.ptid=ppr_pt.ptid" & _
strsql = strsql & " inner join ppr_mpi on ppr_record.mpiid=ppr_mpi.mpiid" & _
strsql = strsql & " inner join ppr_provider on ppr_record.providerid=ppr_provider.providerid" & _
strsql = strsql & " inner join ppr_prescriber on ppr_record.prescriberid=ppr_prescriber.prescriberid" & _
strsql = strsql & " where (ppr_record.countyid = 2)" & _
strsql = strsql & " and (ppr_record.statuspvr='A' " & _
strsql = strsql & " and ppr_record.ymdendpvr='20501231' " & _
strsql = strsql & " and ppr_record.statuspp='A' " & _
strsql = strsql & " and ppr_record.ymdendpp='20501231')" & _
strsql = strsql & " group by ppr_prov_cnty.Provider_Cnty ,ppr_pt.ProviderType,ppr_mpi.MPI,ppr_provider.ProviderName" & _
strsql = strsql & " ,ppr_provider.add1,ppr_provider.add2,ppr_provider.city,ppr_provider.state" & _
strsql = strsql & " ,ppr_provider.zip,ppr_provider.phone" & _
strsql = strsql & " ,ppr_prescriber.Prescribername,ppr_prescriber.Lic,ppr_prescriber.dea"


con.Execute strsql

' Close the database connection.
con.Close

Set con = Nothing
Set tbl = Nothing
Set cat = Nothing

bAns = False
End Function

 

[gmmastros]

ddiamond,
It was good that you posted. Your method (which is equally valid) is different from my method.

Your method works if the table already exists. My method will create the table for you. Depending on requirements, either one is appropriate.

aspag

It looks like you are mixing the line continuation with concantenating a string. You have ' & _' at the end of each line. But each line has strSQL = strSQL & ....

Try removing the ' & _' from your code.

There may be other problems that I don't know about. Insead of executing the sql string, I suggest you debug.print it. Check it for obvious errors. Copy/paste in to Access and try running it. Often times, Access will provide a better error message than VB.

-George

Strong and bitter words indicate a weak cause. - Fortune cookie wisdom

 

[petermeachem]

Do you realise that you can create a table and insert data in the same statement? Use Access to create a make table query and paste the sql into VB. You will have to drop the table before running the make table if it exists. Access will give you a slightly better idea of where the error is.

http://www.accuflight.com

http://www.lettersdirect.co.uk

http://www.ourhouseinportugal.co.uk/