Good afternoon guys.
I created a database to control receipt and delivery of cards. The inclusion of the data is done through a form in excel.
This form also has the option to query existing data. the query returns the information in the form itself for on-screen viewing.
My problem is that if there is more than one record you will not be able to check all of them on the form. My departure then was to create a kind of report. Clicking on Query First is called a function that counts how many records the query will return. If more than one is created an excel file where the records would be saved. However, the Insert Into OpenRowSet function is experiencing an error.
Available below the codes. If anyone can give me a light, I appreciate it.
This code is the counter. it checks the BD how many records are compatible with the search criteria.
Public Function Contador()
Dim TOTAL As Variant
Dim sql As String
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Set cn = New ADODB.Connection
cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & enderecoDB & ";Jet OLEDB:Database"
cn.Open
Set rs = New ADODB.Recordset
sql = "SELECT COUNT (*) FROM controle WHERE BP = '" & controlectform.nmbpbox.Value & "';"
rs.Open sql, cn
If Not rs.EOF Then
Do While Not rs.EOF
TOTAL = rs(0)
rs.MoveNext
Loop
End If
cn.Close
Contador = TOTAL
End Function
If the value returned is greater than 1 (Counter > 1) then a function that creates the xls file is called:
Public Function CriaArquivo()
Dim NovoArquivoXLS As Workbook
Dim sht As Worksheet
Dim mPathSave As String
Dim PlanName As String
mPathSave = ThisWorkbook.Path
PlanName = "SQLQueryControleCartoes"
'Cria um novo arquivo excel
Set NovoArquivoXLS = Application.Workbooks.Add
'Salva o arquivo
NovoArquivoXLS.SaveAs mPathSave & "\" & PlanName & ".xls"
Call Cabecalho
End Function
The CreateArchive function, in turn, calls another function that inserts the header:
Public Function Cabecalho()
Dim vArray As Variant 'variável insere dados vArray
Dim vContador As Integer
' variavel vArrays variant com array de dados
vArray = Array("", "ID", "TP_BENEFICIO", "BP", "CPF", "NOME", "DTADM", "FILIAL", "SOLICPOR", "DTSOLIC", _
"DTRECEBE", "DTENVIOBS", "ENVIADORETIRADO", "NMMINUTA", "NRCARTAO")
'Inserindo o cabeçalho na folha de planilha
With Worksheets("Planilha1")
For vContador = 1 To UBound(vArray)
.Cells(1, vContador).Value = vArray(vContador)
Next vContador
End With
End Function
After all this process is called the function to insert the data into the worksheet:
Public Function Relatorio()
Dim sql As String
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim rel As String
Set cn = New ADODB.Connection
cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & enderecoDB & ";Jet OLEDB:Database"
cn.Open
Set rs = New ADODB.Recordset
sql = "INSERT INTO OPENROWSET('Microsoft.Jet.OLEDB.4.0', 'Excel 8.0;Database= " & ThisWorkbook.Path & "\SQLQueryControleCartoes.xls', 'SELECT * FROM controle WHERE BP = '" & controlectform.nmbpbox.Value & "')"
rs.Open sql, cn
End Function
All codes are executed normally. The file is created and the header is inserted. But at the time of entering the results of the query the error below is displayed:
Theerrorispointedoutinthepenultimaterowofthereportfunctionwherethe"rs.Open sql, cn"