Ir para conteúdo

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

SabrinaBottan

[Resolvido] Consulta+excel

Recommended Posts

Olá Sabrina, bem vinda ao Fórum.

 

Você poderia antes especificar melhor o que deseja, mas se entendi bem não é tão complicado assim,

 

Clicando Aqui Você encontrará uma matéria muito bem explicada de como exportar e importar dados para

o excel.

 

Caso ainda haja dúvidas quanto ao código pode perguntar à nós que nós tentaremos responder.

 

Se conseguiu, mande-nos uma resposta.

 

Paulo Mendes.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Olá eu achei o código que preciso, mas não estou conseguindo fazer a referência ao banco de dados

 

 

 

Dim oExcel As Object

Dim objExlSht As Object

 

Dim Rs1 As ADODB.Recordset

 

 

Set oExcel = CreateObject("Excel.Application")

oExcel.Workbooks.Add 'inclui o workbook

Set objExlSht = oExcel.ActiveWorkbook.Sheets(1)

 

 

Set Rs1 = New ADODB.Recordset

 

Rs1.Open Source:="Select Title From Titles WHERE pubID < 5 ORDER BY Title", _

ActiveConnection:="DBQ=C:\TESTE\biblio.MDB;Driver={Microsoft Access Driver (*.mdb)};", _

CursorType:=adOpenStatic, _

LockType:=adLockOptimistic, _

Options:=adCmdText

 

 

With Worksheets("Plan1")

.Range("A1").CurrentRegion.Clear

Application.Intersect(.Range(.Rows(1), .Rows(Rs1.RecordCount)), _

.Range(.Columns(1), .Columns(Rs1.Fields.Count))).Value = _

Application.Transpose(Rs1.GetRows(Rs1.RecordCount))

End With

 

objExlSht.SaveAs "C:\teste\teste901.xls"

oExcel.Visible = True

 

Rs1.Close

Set Rs1 = Nothing

Compartilhar este post


Link para o post
Compartilhar em outros sites

Olá.

 

Creio que o seu problema esteja apenas na conexão mesmo.

 

troque essa parte

 

Dim Rs1 As ADODB.Recordset


Set oExcel = CreateObject("Excel.Application")
oExcel.Workbooks.Add 'inclui o workbook
Set objExlSht = oExcel.ActiveWorkbook.Sheets(1)


Set Rs1 = New ADODB.Recordset

Rs1.Open Source:="Select Title From Titles WHERE pubID < 5 ORDER BY Title", _
ActiveConnection:="DBQ=C:\TESTE\biblio.MDB;Driver={Microsoft Access Driver (*.mdb)};", _
CursorType:=adOpenStatic, _
LockType:=adLockOptimistic, _
Options:=adCmdText

por isso

 

Dim str_Cn as String
Dim Cn as New ADODB.Connection
Dim Rs1 As  New ADODB.Recordset
Dim str_SQL as String

Set oExcel = CreateObject("Excel.Application")
oExcel.Workbooks.Add 'inclui o workbook
Set objExlSht = oExcel.ActiveWorkbook.Sheets(1)

str_Cn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\TESTE\biblio.MDB;"

Cn.Open str_Cn '| Abrindop conexao com o banco

str_SQL = "Select Title From Titles WHERE pubID < 5 ORDER BY Title"
Rs1 .Open str_SQL, Cn

Poste caso não funcione, mas o que faltou foi o conceito de string de conexão e recordset. Qualquer dúvida é só postar.

 

Paulo Mendes.

Compartilhar este post


Link para o post
Compartilhar em outros sites
CODE
CODE
Private Sub Relexcel_Click()
Dim oExcel As Object
Dim objExlSht As Object
Dim str_Cn As String
Dim Cn As New ADODB.Connection
Dim Rs1 As New ADODB.Recordset
Dim str_SQL As String

Set oExcel = CreateObject("Excel.Application")
oExcel.Workbooks.Add 'inclui o workbook
Set objExlSht = oExcel.ActiveWorkbook.Sheets(1)

str_Cn = "Provider=MSDAORA;Data Source=DEVELOP;Password=TESTE;User Id=TESTE"

Cn.Open str_Cn '| Abrindop conexao com o banco

str_SQL = "Select NM_ALUNO, NM_SERIE, NM_IDADE FROM PJ_ALUNO WHERE NM_SERIE = 5"

Rs1.Open str_SQL, Cn


With Worksheets("Plan1")
.Range("A1").CurrentRegion.Clear
Application.Intersect(.Range(.Rows(1), .Rows(Rs1.RecordCount)), _
.Range(.Columns(1), .Columns(Rs1.Fields.Count))).Value = _
Application.Transpose(Rs1.GetRows(Rs1.RecordCount))
End With

objExlSht.SaveAs "C:\PJ\teste.xls"
oExcel.Visible = True

Rs1.Close
Set Rs1 = Nothing

End Sub




Não tá funcionando

Compartilhar este post


Link para o post
Compartilhar em outros sites

Consegui exibir a consulta no excel, mas não consigo exibir mais de uma coluna

Alguem sabe como faz??????

 

CODE

Private Sub Relexcel_Click()

Dim oExcel As Object

Dim str_Cn As String

Dim Cn As New ADODB.Connection

Dim Rs1 As New ADODB.Recordset

Dim str_SQL As String

Dim i As Integer

 

Set oExcel = CreateObject("Excel.Application")

oExcel.Workbooks.Add 'inclui o workbook

 

 

str_Cn = "Provider=MSDAORA;Data Source=DEVELOP;Password=TESTE;User Id=TESTE"

 

Cn.Open str_Cn '| Abrindop conexao com o banco

 

str_SQL = "Select NM_ALUNO FROM PJ_ALUNO WHERE NM_SERIE = 5"

 

Rs1.Open str_SQL, Cn

 

 

 

With Worksheets("Plan1").Range("A1")

.CurrentRegion.Clear

.CopyFromRecordset Rs1

End With

 

 

 

oExcel.Visible = True

 

Rs1.Close

Set Rs1 = Nothing

 

End Sub

Compartilhar este post


Link para o post
Compartilhar em outros sites

Fiz assim e deu certo

 

Obrigado Paulo pela ajuda

CODE

Private Sub Relexcel_Click()

Dim oExcel As Object

Dim str_Cn As String

Dim Cn As New ADODB.Connection

Dim Rs1 As New ADODB.Recordset

Dim str_SQL As String

Dim i As Integer

 

Set oExcel = CreateObject("Excel.Application")

oExcel.Workbooks.Add 'inclui o workbook

 

str_Cn = "Provider=MSDAORA;Data Source=DEVELOP;Password=TESTE;User Id=TESTE"

 

Cn.Open str_Cn '| Abrindop conexao com o banco

 

str_SQL = "Select NM_ALUNO, NM_SERIE, NM_IDADE FROM PJ_ALUNO WHERE NM_SERIE = 5"

 

Rs1.Open str_SQL, Cn

 

Range("A1").Value = "aluno"

Range("B1").Value = "serie"

Range("C1").Value = "idade"

i = 2

If Not Rs1.EOF Then

Do While Not Rs1.EOF

Range("A" & i).Value = Rs1(0)

Range("B" & i).Value = Rs1(2)

Range("C" & i).Value = Rs1(1)

Rs1.MoveNext

i = i + 1

Loop

End If

 

oExcel.Visible = True

 

Rs1.Close

Set Rs1 = Nothing

 

End Sub

Compartilhar este post


Link para o post
Compartilhar em outros sites

×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.